Análise Qualidade do Vinho
Análise Qualidade do Vinho
Início
Introdução
Trabalho de conlusão Matéria : CONCEITOS ESTATÍSTICOS PARA IA Professora: ADELAIDE ALVES DE OLIVEIRA
Integrantes do Grupo E2GR:
- EDUARDO MORAIS [ 334530 ]
- EDUARDO SIQUEIRA DE LIMA [ 334304 ]
- GABRIEL SHIKAMA [ 334068 ]
- RICARDO CALIMANIS [ 334759 ]
Análise realizada no dataset WineQuality onde aplicaremos todas as técnicas aprendidas em sala de aula.
Preparando o Ambiente
Instalando os pacotes necessários
Instalando os pacotes necessários para realizar as análises
#lista de pacotes que iremos utilizar no projeto
Pacotes_Necessarios <- c("ggplot2","readr","dplyr","corrplot","plotly","skimr","GGally","gmodels","ggpubr","caTools",
"caret" ,"rpart.plot","DT","e1071","corrgram")
#com base nos pacotes instalados crio uma variavel somente com os pacotes
#que não temos ainda para realizar a instalação
#dos pacotes que de fato não possuimos
PacotesNovos <- Pacotes_Necessarios[!(Pacotes_Necessarios %in% installed.packages()[,"Package"])]
if(length(PacotesNovos)){ install.packages(PacotesNovos)} else {print("Todos os Pacotes Estão Instalados")}[1] "Todos os Pacotes Estão Instalados"Carregando os Pacotes
[[1]]
[1] TRUE
[[2]]
[1] TRUE
[[3]]
[1] TRUE
[[4]]
[1] TRUE
[[5]]
[1] TRUE
[[6]]
[1] TRUE
[[7]]
[1] TRUE
[[8]]
[1] TRUE
[[9]]
[1] TRUE
[[10]]
[1] TRUE
[[11]]
[1] TRUE
[[12]]
[1] TRUE
[[13]]
[1] TRUE
[[14]]
[1] TRUE
[[15]]
[1] TRUEDataset
Carregando o DataSet
A fim de facilitar a compreensão e desenvolvimento de nosso codigo decidimos mudar os nomes das colunas do data set, a tabela a baixo indica o nome original do arquivo e o nome que propuzemos
Lista DE - PARA das colunas
| Nome no Arquivo | Nome Traduzido |
|---|---|
| ID | ID (que não sera utilizado) |
| fixed acidity | acidez_fixa |
| volatile acidity | acidez_volatil |
| citric acid | acido_citrico |
| residual sugar | acucar_residual |
| chlorides | cloretos |
| free sulfur dioxide | fsd |
| total sulfur dioxide | tsd |
| density | densidade |
| pH | PH |
| sulphates | sulfatos |
| alcohol | grau_alcolico |
| quality | qualidade |
| Vinho | Tipo |
#Criando uma variável nome_colunas que receberá os nomes das colunas que normalizaremos a fim de facilitar o resto da análise
nome_colunas <- c("id","acidez_fixa","acidez_volatil","acido_citrico","acucar_residual","cloretos", "fsd", "tsd","densidade","PH",
"sulfatos","grau_alcolico","qualidade","tipo")
#uso da biblioteca readr é para obter uma performance de carga melhor que a lib padrão do R
#e escolhemos o read_csv2 justamente pelo fato do arquivo estar separado por ; ao invés de ,
#o separador decimal também não é o . que é convencional e este comando ja os converte facilmente
#skip = 1 para ignorar o cabecalho que mudamos para melhor entendimento
setwd("/mnt/hgfs/kal1s/files/cyberAI/Training/Fiap/MBA/Disciplinas/TrabalhosFiap/EstatisticaIA/Final")
vinhos <- read_csv2("Arquivos/BaseWine_Red_e_White.csv" ,col_names = nome_colunas, skip = 1)Análise Exploratória
Observando o DataFrame
Exibindo as Dimensões do dataframe vinhos
[1] 6497 14Exibindo a Estrutura do dataframe vinhos
Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 6497 obs. of 14 variables:
$ id : num 1 2 3 4 5 6 7 8 9 10 ...
$ acidez_fixa : num 6.6 6.7 10.6 5.4 6.7 6.8 6.6 7.2 5.1 6.2 ...
$ acidez_volatil : num 0.24 0.34 0.31 0.18 0.3 0.5 0.61 0.66 0.26 0.22 ...
$ acido_citrico : num 0.35 0.43 0.49 0.24 0.44 0.11 0 0.33 0.33 0.2 ...
$ acucar_residual: num 7.7 1.6 2.2 4.8 18.8 ...
$ cloretos : num 0.031 0.041 0.063 0.041 0.057 0.075 0.069 0.068 0.027 0.035 ...
$ fsd : num 36 29 18 30 65 16 4 34 46 58 ...
$ tsd : num 135 114 40 113 224 49 8 102 113 184 ...
$ densidade : num 0.994 0.99 0.998 0.994 1 ...
$ PH : num 3.19 3.23 3.14 3.42 3.11 3.36 3.33 3.27 3.35 3.11 ...
$ sulfatos : num 0.37 0.44 0.51 0.4 0.53 0.79 0.37 0.78 0.43 0.53 ...
$ grau_alcolico : num 10.5 12.6 9.8 9.4 9.1 9.5 10.4 12.8 11.4 9 ...
$ qualidade : num 5 6 6 6 5 5 4 6 7 6 ...
$ tipo : chr "WHITE" "WHITE" "RED" "WHITE" ...
- attr(*, "spec")=
.. cols(
.. id = col_double(),
.. acidez_fixa = col_double(),
.. acidez_volatil = col_double(),
.. acido_citrico = col_double(),
.. acucar_residual = col_double(),
.. cloretos = col_double(),
.. fsd = col_double(),
.. tsd = col_double(),
.. densidade = col_double(),
.. PH = col_double(),
.. sulfatos = col_double(),
.. grau_alcolico = col_double(),
.. qualidade = col_double(),
.. tipo = col_character()
.. )Validações Iniciais
Exibindo a Sumario e um histograma inicial do dataframe vinhos
options(width = 900) #definindo o tamanho da area de impressão de saida do markdown
options(max.print=500) # aumentando a saida da lista, sem esta opção alguns resultados tendem a ser cortados
skim(vinhos[, names(vinhos) != "id"] ) #retirando a coluna ID da análiseSkim summary statistics
n obs: 6497
n variables: 13
── Variable type:character ───────────────────────────────────────────────────────────────────────────────────────────
variable missing complete n min max empty n_unique
tipo 0 6497 6497 3 5 0 2
── Variable type:numeric ─────────────────────────────────────────────────────────────────────────────────────────────
variable missing complete n mean sd p0 p25 p50 p75 p100 hist
acidez_fixa 0 6497 6497 7.22 1.3 3.8 6.4 7 7.7 15.9 ▁▇▇▂▁▁▁▁
acidez_volatil 0 6497 6497 0.34 0.16 0.08 0.23 0.29 0.4 1.58 ▇▇▂▁▁▁▁▁
acido_citrico 0 6497 6497 0.32 0.15 0 0.25 0.31 0.39 1.66 ▂▇▂▁▁▁▁▁
acucar_residual 0 6497 6497 5.44 4.73 0.6 1.8 3 8.1 45.8 ▇▂▂▁▁▁▁▁
cloretos 0 6497 6497 0.056 0.035 0.009 0.038 0.047 0.065 0.61 ▇▁▁▁▁▁▁▁
densidade 0 6497 6497 0.99 0.003 0.99 0.99 0.99 1 1.01 ▂▇▇▅▁▁▁▁
fsd 0 6497 6497 30.53 17.75 1 17 29 41 289 ▇▃▁▁▁▁▁▁
grau_alcolico 0 6497 6497 10.49 1.22 0.96 9.5 10.3 11.3 14.9 ▁▁▁▁▆▇▃▁
PH 0 6497 6497 3.22 0.16 2.72 3.11 3.21 3.32 4.01 ▁▃▇▇▃▁▁▁
qualidade 0 6497 6497 5.82 0.87 3 5 6 6 9 ▁▁▆▇▁▃▁▁
sulfatos 0 6497 6497 0.53 0.15 0.22 0.43 0.51 0.6 2 ▅▇▂▁▁▁▁▁
tsd 0 6497 6497 115.74 56.52 6 77 118 156 440 ▅▆▇▃▁▁▁▁Observa-se que:
- O campo
acucar_residual,fsd,tsdpossuem um desvio padrão acima das demais variaveis - A maioria dos histogramas apresenta uma distribuição normal entretanto não centralizado o que pode indicar a presença de outliers
Checar presença de nulos
id acidez_fixa acidez_volatil acido_citrico acucar_residual cloretos fsd tsd densidade PH sulfatos grau_alcolico qualidade tipo
FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE O resultado acima nos descreve que não há presença de nulos na base, isto é indicado pelo retorno FALSE em cada variável
Checar presença de Registros Duplicados
Para prover melhor performance e acurácia de nossos modelos iremos verificar a existência de registros duplicados e removê-los se existir, mais antes é necessário remover uma coluna, ou simplesmente ignorar, que é a coluna ID que contem algum tipo de código incremental.
#removendo a coluna Id que não é necessária para nossa analise
vinhos<- vinhos[-1]
vinhos[duplicated(vinhos, fromLast = TRUE), ]# A tibble: 1,177 x 13
acidez_fixa acidez_volatil acido_citrico acucar_residual cloretos fsd tsd densidade PH sulfatos grau_alcolico qualidade tipo
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
1 6.6 0.24 0.35 7.7 0.031 36 135 0.994 3.19 0.37 10.5 5 WHITE
2 6.6 0.25 0.36 8.1 0.045 54 180 0.996 3.08 0.42 9.2 5 WHITE
3 7.2 0.63 0 1.9 0.097 14 38 0.997 3.37 0.580 9 6 RED
4 8.5 0.15 0.49 1.5 0.031 17 122 0.993 3.03 0.4 10.3 6 WHITE
5 6.6 0.19 0.43 10.9 0.045 53 154 0.998 3.52 0.77 10.4 6 WHITE
6 7.2 0.32 0.3 8.25 0.02 14 104 0.994 2.99 0.44 11.4 6 WHITE
7 6.4 0.45 0.07 1.1 0.03 10 131 0.990 2.97 0.28 10.8 5 WHITE
8 6.3 0.24 0.290 13.7 0.035 53 134 0.996 3.17 0.38 10.6 6 WHITE
9 11.1 0.31 0.53 2.2 0.06 3 10 0.996 3.02 0.83 10.9 7 RED
10 7 0.23 0.26 7.2 0.041 21 90 0.995 3.22 0.55 9.5 6 WHITE
# … with 1,167 more rowsDe fato existem 1176 registros duplicados onde:
# A tibble: 2 x 2
tipo n
<chr> <int>
1 RED 240
2 WHITE 937Removendo as linhas duplicadas
Histograma
Imprimindo Histogramas das variaveis
attach(vinhos)
Rotulos_Colunas <-c("acidez_fixa","acidez volatil" ,"acido citrico","acucar residual","cloretos","fsd","tsd","densidade",
"PH","sulfatos","grau alcolico","qualidade","tipo")
grafico_lista <- vector("list", length = length(Rotulos_Colunas)-2)
for(i in 2:13){
grafico_lista[[i-1]] <- plot_ly(x = as.formula(vinhos[i]), type = 'histogram', name = Rotulos_Colunas[i])
}
subplot(grafico_lista, nrows = 4)Podemos observar que quase em todas variáveis possuem um desenho ser similar à uma distribuição normal no entanto isso se deu pois mais à esquerda exceto grau alcoolico. Isso pode indicar presença de Outliers. A Conslusão que já se pode tirar é que há erros no Teor alcoolico, haja visto que é sabido que não existe vinhos com teor alcoolico a baixo de 8.
Explorando o DataSet
Nosso intuito nesta parte é entender se podemos considerar o dataset como um todo ou se devemos observá-los por tipo de vinho para isso iremos agregar os dados por tipo de vinho e ver como as variáveis se comportam
Group.1 acidez_fixa acidez_volatil acido_citrico acucar_residual cloretos fsd tsd densidade PH sulfatos grau_alcolico tipo
1 RED 1.7244751 0.1828621 0.1953835 1.352552 0.04936924 10.45414 33.42622 0.001859119 0.1535224 0.1707834 1.168107 NA
2 WHITE 0.8648942 0.1032085 0.1223250 4.808328 0.02314657 17.21688 43.11269 0.002830119 0.1514866 0.1135190 1.215335 NANos parece que há algumas diferenças significativas levando em consideração, os desvios padrão agregado por tipo de vinho onde:
| Observações | |
|---|---|
| 1 | Acidez fixa é quase o dobro em vinhos Tintos |
| 2 | Acidez Volatil é maior 0.7 desvios em Tintos |
| 3 | Ácido Cítrico é quase 4 desvios maior em Brancos |
| 4 | Cloretos maior que 2 desvios em Tintos |
| 5 | Sulfatos (fsd e tsd) é Maior em Brancos |
| 6 | Densidade é maior em Brancos |
Entretanto a Qualidade não varia, ou seja em nossa perceção as características que determinam qualidade para os vinhos são diferentes e iremos ver a seguir a correlação dessas variáveis.
Preparação dos Dados
Técnica
Transformação de qualidade em variável categórica
Decidimos por classificar a nota da qualidade inicialmente em três grupos:
| Grupo | Notas |
|---|---|
| Ruim | 0 ~ 5.99 |
| Regular | 6 ~ 7.99 |
| Bom | >= 8 |
Neste caso, poderíamos utilizar algoritmos supervisionados como o K-means pra predizer em qual categoria um vinho se encontra.
Porém, consideramos que isso não faria sentido para rodar os modelos não supervisionados.
Para rodar este modelo, decidimos criar a variável GrupoQualidade, sendo qualquer qualidade com valor maior ou superior a 6 é classificado como vinho “BOM”. A variável GrupoQualidade será nossa variável dependente no caso.
vinhos$GrupoQualidade <- as.factor(ifelse(vinhos$qualidade > 6,1,0))
vinhos$GrupoQualidadeF <- as.factor(ifelse(vinhos$qualidade > 'Bom','Regular','Ruim'))Como Identificamos que pode fazer sentido analisar o vinho de maneira separada por tipo já que muitas variáveis tendem a se comportar de forma diferente vamos iniciar a preparação dos dados separando o dataset em 2 : df_base_tinto e df_base_branco
Transformação Box Cox
Em estatística, uma transformação de potência é uma família de funções que são aplicadas para criar a transformação monotônica de dados usando funções de potência. Esta é uma técnica de transformação de dados útil usada para estabilizar a variância, tornar os dados mais semelhantes à distribuição normal, melhorar a validade das medidas de associação (como a correlação de Pearson entre as variáveis) e para outros procedimentos de estabilização de dados.
Tanto a forma linear quanto a logarítmica são dois casos particulares de uma família mais extensa de transformações não-lineares. A transformação de potência é definida como uma função de variação contínua, em relação ao parâmetro de potência ?? (lambda), ou seja, x??. Uma classe geral de transformação que pode ser utilizada é a de Box-Cox, definida por:
para ?? diferente de 0 \[f_\lambda(x) = \frac{(x)^\lambda - 1}{\lambda} \]
para ?? = 0 \[f_0 = log(x)\]
Se a assimetria for 0, os dados são perfeitamente simétricos. Como regra geral: Se a assimetria for menor que -1 ou maior que 1, a distribuição é muito distorcida. Se a assimetria estiver entre -0,5 e 0,5, a distribuição é aproximadamente simétrica.
Usamos a transformação Boxcox e transformamos os dados e depois verificaremos a assimetria.
Vinho Tinto
Antes de transformar
acidez_fixa acidez_volatil acido_citrico acucar_residual cloretos fsd tsd densidade PH sulfatos grau_alcolico qualidade
0.91485260 0.73281550 0.31273584 4.54525487 5.50447109 1.22160470 1.53514979 0.02442147 0.18594471 2.40027683 -0.41917821 0.19029133 Transformado
#preparação para a transformação dos dados
df_prep_tinto <- preProcess(df_base_tinto[,1:12], c("BoxCox", "center", "scale"))
df_tinto <- data.frame(trans = predict(df_prep_tinto, df_base_tinto))
df_tinto trans.acidez_fixa trans.acidez_volatil trans.acido_citrico trans.acucar_residual trans.cloretos trans.fsd trans.tsd trans.densidade trans.PH trans.sulfatos trans.grau_alcolico trans.qualidade trans.tipo trans.GrupoQualidade trans.GrupoQualidadeF
1 1.29810397 -1.30627760 1.1128181 -0.001850401 -0.82713940 0.4996845 0.11714245 0.48189651 -1.11049223 -1.10481974 -0.54687971 0.4734439 RED 0 Ruim
2 -0.90674030 -0.04068574 -0.8320752 -1.770944466 -0.19322793 0.3275594 0.40235823 -0.67524163 0.35076797 1.00360974 -0.79972927 -0.7472466 RED 0 Ruim
3 -1.07715256 0.54161620 -1.3950707 -1.413132729 -0.48812008 -1.6983347 -2.14478317 -1.48157418 0.15723705 -3.44091800 -0.03188984 -2.0440277 RED 0 Ruim
4 -0.58885353 0.78209311 0.2939156 0.429376804 -0.54128582 1.4291018 1.43274060 -1.38397230 -0.23511109 0.95548972 2.14452807 0.4734439 RED 0 Ruim
5 -0.66563360 1.11995637 -0.5761682 -0.585096957 0.71805697 0.2332445 1.03758418 -0.05537573 -0.23511109 0.11482793 -0.96653593 -0.7472466 RED 0 Ruim
6 -1.25603319 -1.30627760 -0.9344380 -2.185373773 -0.65146465 0.2332445 -0.38413330 -1.14019941 0.73269923 0.51835513 -0.37657898 1.6342878 RED 1 Ruim
7 0.55286643 0.39063408 -0.1155356 -0.369266476 0.83055275 -0.6853877 -0.78844554 0.53017178 -0.23511109 0.63720916 -0.71579582 -0.7472466 RED 0 Ruim
8 -0.51376096 1.11995637 -1.3950707 -0.001850401 0.02510614 0.4996845 -0.38413330 0.50871772 0.66951162 -0.20144425 -0.88331005 -0.7472466 RED 0 Ruim
9 -0.90674030 0.33909336 -1.3950707 0.429376804 -0.33575840 1.3405065 0.77769185 -0.96705101 0.79570235 -0.56532142 0.67340363 0.4734439 RED 0 Ruim
10 -0.09550469 0.78209311 -1.3950707 -2.185373773 0.59812238 -1.1057987 -1.46244398 -0.54570095 0.79570235 -0.37679561 -0.79972927 -0.7472466 RED 0 Ruim
11 -0.74416367 -0.09792533 1.1128181 2.042197146 -1.01673184 1.0370678 1.67281014 0.37457133 0.22194040 0.85525644 0.05512239 -0.7472466 RED 0 Ruim
12 0.85556854 0.28691575 0.1915528 0.760103637 0.36775371 0.2332445 0.31356576 0.64276330 -1.31764793 1.52972247 -0.37657898 0.4734439 RED 0 Ruim
13 -0.66563360 1.03231257 -1.3950707 0.228898736 -0.38540000 0.7249562 0.34379086 -0.20610194 -0.10353414 -1.91937754 -0.88331005 -0.7472466 RED 0 Ruim
14 0.33248920 0.71132987 -0.1155356 -0.369266476 0.14591307 -0.6853877 -0.38413330 0.77670817 -0.16922232 -0.20144425 -0.37657898 0.4734439 RED 0 Ruim
15 -0.03070873 0.68748629 -0.2690798 0.298789583 0.53510993 -1.3722386 -0.15321959 -0.31384135 0.41489447 -0.37679561 0.49512800 -0.7472466 RED 0 Ruim
16 0.60552813 1.22719411 2.0852647 -1.101346266 3.49260072 0.4996845 0.77769185 -0.09842740 -2.82624749 2.49091477 -1.13191376 0.4734439 RED 0 Ruim
17 -1.07715256 0.78209311 -1.3950707 0.940494470 1.10712681 0.7249562 -0.24108654 -0.22225872 0.92115940 0.03971108 -0.11856806 -0.7472466 RED 0 Ruim
18 0.60552813 -1.81919259 0.3450970 -0.369266476 -0.38540000 1.8387277 0.84207319 0.53017178 0.85852205 1.30764683 -0.20491030 1.6342878 RED 1 Ruim
19 1.67848445 -0.52343785 1.3175437 1.166359316 0.85760115 1.3854754 1.37651657 2.29659343 -0.70205317 1.62973885 -1.04940460 -0.7472466 RED 0 Ruim
20 0.03280413 1.33199018 1.2663623 -0.369266476 1.26205563 1.5526717 2.00258670 0.10597572 -0.63472534 0.45621255 -0.96653593 -0.7472466 RED 0 Ruim
21 -0.16162642 0.96544681 -1.0879823 -0.585096957 -0.01678723 0.6536556 -0.07052436 -0.22764463 0.60613844 0.45621255 0.40647376 -0.7472466 RED 0 Ruim
22 0.60552813 0.87471384 -0.8320752 0.760103637 0.50279295 -0.2200077 0.25109265 1.16725178 0.02724537 -0.66498947 -0.79972927 0.4734439 RED 0 Ruim
23 -1.25603319 -0.92972053 -0.3202612 -0.001850401 -2.05372208 1.0370678 0.37337961 -0.04999500 1.04589127 0.90605649 -0.63151191 0.4734439 RED 0 Ruim
24 -1.54179892 -0.15598858 -0.9344380 -1.101346266 -0.05953776 0.4996845 -0.28716979 -1.44903433 0.92115940 -0.76853705 0.67340363 0.4734439 RED 0 Ruim
25 -0.51376096 -1.00195901 -0.1667170 -0.369266476 -0.59571744 1.1453673 0.37337961 -0.50793589 0.79570235 -0.76853705 -0.37657898 -2.0440277 RED 0 Ruim
26 0.44468133 -1.15088850 0.7033668 2.102183529 -0.28720784 -0.8805269 -1.46244398 -0.06613768 -0.03804531 -0.03795208 1.49126777 1.6342878 RED 1 Ruim
27 -0.16162642 1.22719411 -1.1903451 0.155658083 0.46991515 0.2332445 0.53891347 0.15972717 -0.30120165 0.18751981 -0.54687971 -0.7472466 RED 0 Ruim
28 -2.07169956 0.78209311 -1.3950707 0.429376804 -0.65146465 -0.8805269 -1.26132813 -2.24251338 1.35460259 -0.37679561 2.23904186 -0.7472466 RED 0 Ruim
29 2.48598925 -1.30627760 2.3923531 -0.827449926 -0.19322793 -1.1057987 -1.26132813 2.19035827 -3.12595443 1.00360974 -1.69920708 0.4734439 RED 0 Ruim
30 0.55286643 -0.27470530 0.1915528 0.760103637 0.50279295 0.5786969 1.37651657 0.77670817 0.09233910 0.03971108 -0.79972927 0.4734439 RED 0 Ruim
31 0.15614188 0.85173934 -0.0643542 -0.175936801 0.18464179 -0.2200077 0.21878287 0.48189651 0.02724537 -0.87619130 -1.04940460 -2.0440277 RED 0 Ruim
32 -3.39884588 0.07143227 -0.6273496 -0.175936801 -1.44558384 -0.6853877 0.79948164 -1.78556382 3.56674009 -0.56532142 2.42894867 -2.0440277 RED 0 Ruim
33 0.09507466 1.14160592 -0.9344380 -0.369266476 -0.59571744 -1.3722386 -1.83117423 -1.36229019 -0.16922232 -0.46932211 1.21584497 0.4734439 RED 0 Ruim
[ reached 'max' / getOption("max.print") -- omitted 1323 rows ]#remove df desnecessario
rm("df_prep_tinto")
#atribui os nomes originais
colnames(df_tinto) <- colnames(df_base_tinto)
apply(df_tinto[1:12], 2, skewness, na.rm =TRUE) acidez_fixa acidez_volatil acido_citrico acucar_residual cloretos fsd tsd densidade PH sulfatos grau_alcolico qualidade
-0.008129168 -0.021898189 0.312735835 -0.069661390 -0.699341059 -0.221201247 -0.079340151 0.001059093 0.005566550 -0.008826281 0.329256703 0.027293765 Vinho Branco
Antes de transformar
acidez_fixa acidez_volatil acido_citrico acucar_residual cloretos fsd tsd densidade PH sulfatos grau_alcolico qualidade
0.7013495 1.6414430 1.3196543 1.0366612 4.9573952 1.5699091 0.4583929 0.4477260 0.4595307 0.9342072 0.4465706 0.1113035 Transformado
#preparação para a transformação dos dados
df_prep_branco <- preProcess(df_base_branco[,1:12], c("BoxCox", "center", "scale"))
df_branco <- data.frame(trans = predict(df_prep_branco, df_base_branco))
#atribui os nomes originais
colnames(df_branco) <- colnames(df_base_branco)
#remove df desnecessario
rm("df_prep_branco")
apply(df_branco[1:12], 2, skewness, na.rm =TRUE) acidez_fixa acidez_volatil acido_citrico acucar_residual cloretos fsd tsd densidade PH sulfatos grau_alcolico qualidade
0.11732154 0.16899788 1.31965427 -0.06001957 -0.14971492 0.09643235 0.01203796 0.42170951 -0.01219325 -0.02215590 0.03746823 0.11130348 Outliers
A maioria das estatísticas paramétricas, como médias, desvios-padrão e correlações, e todas as estatísticas com base nelas, são altamente sensíveis a outliers. As premissas dos procedimentos estatísticos comuns, como regressão linear e ANOVA, também são baseadas nessas estatísticas, quando outliers podem perturbar a estatística. análise. Assim, nós removemos os outliers.
Possivelmente, o passo mais importante na preparação de dados é identificar outliers. Como se trata de dados multivariados, consideramos apenas aqueles pontos que não possuem nenhum valor de variável de previsão para estar fora dos limites construídos pelos boxplots. A seguinte regra é aplicada:
Um valor preditivo é considerado um valor discrepante somente se for maior que 3 Desvios Padrão. A lógica por trás dessa regra é que os valores extremos extremos estão todos na extremidade superior dos valores e as distribuições são todas positivamente distorcidas.
Vinho Tinto
Identificando os Outliers
Iremos a seguir criar um dataframe somente para ter a quantidade de outliers identificados para cada variável, usaremos o comando abs para obter a posicão absoluta onde o desvio padrão é > 3 como ja fora transformado no passo anterior
outlier <- data.frame(matrix(ncol = 1, nrow = 1))
colnames(outlier)<-"tipo"
outlier$tipo = "Tinto"
outlier$acidez_fixa <- count(df_tinto[abs(df_tinto$acidez_fixa)>3,])
outlier$acidez_volatil <-count(df_tinto[abs(df_tinto$acidez_volatil)>3,])
outlier$acido_citrico <-count(df_tinto[abs(df_tinto$acido_citrico)>3,])
outlier$acucar_residual <-count(df_tinto[abs(df_tinto$acucar_residual)>3,])
outlier$cloretos <-count(df_tinto[abs(df_tinto$cloretos)>3,])
outlier$fsd <-count(df_tinto[abs(df_tinto$fsd)>3,])
outlier$tsd <-count(df_tinto[abs(df_tinto$tsd)>3,])
outlier$densidade <-count(df_tinto[abs(df_tinto$densidade)>3,])
outlier$PH <-count(df_tinto[abs(df_tinto$PH)>3,])
outlier$sulfatos <-count(df_tinto[abs(df_tinto$sulfatos)>3,])
outlier$grau_alcolico <-count(df_tinto[abs(df_tinto$grau_alcolico)>3,])
summary(outlier) tipo acidez_fixa.n acidez_volatil.n acido_citrico.n acucar_residual.n cloretos.n fsd.n tsd.n densidade.n PH.n sulfatos.n grau_alcolico.n
Length:1 Min. :2 Min. :4 Min. :1 Min. :7 Min. :25 Min. :2 Min. :0 Min. :12 Min. :7 Min. :6 Min. :10
Class :character 1st Qu.:2 1st Qu.:4 1st Qu.:1 1st Qu.:7 1st Qu.:25 1st Qu.:2 1st Qu.:0 1st Qu.:12 1st Qu.:7 1st Qu.:6 1st Qu.:10
Mode :character Median :2 Median :4 Median :1 Median :7 Median :25 Median :2 Median :0 Median :12 Median :7 Median :6 Median :10
Mean :2 Mean :4 Mean :1 Mean :7 Mean :25 Mean :2 Mean :0 Mean :12 Mean :7 Mean :6 Mean :10
3rd Qu.:2 3rd Qu.:4 3rd Qu.:1 3rd Qu.:7 3rd Qu.:25 3rd Qu.:2 3rd Qu.:0 3rd Qu.:12 3rd Qu.:7 3rd Qu.:6 3rd Qu.:10
Max. :2 Max. :4 Max. :1 Max. :7 Max. :25 Max. :2 Max. :0 Max. :12 Max. :7 Max. :6 Max. :10 Encontramos 67 observações e iremos remover de nossa análise
Removendo os outliers
df_tinto <- df_tinto[!abs(df_tinto$acidez_fixa)>3,]
df_tinto <- df_tinto[!abs(df_tinto$acidez_volatil)>3,]
df_tinto <- df_tinto[!abs(df_tinto$acido_citrico)>3,]
df_tinto <- df_tinto[!abs(df_tinto$acucar_residual)>3,]
df_tinto <- df_tinto[!abs(df_tinto$cloretos)>3,]
df_tinto <- df_tinto[!abs(df_tinto$fsd)>3,]
df_tinto <- df_tinto[!abs(df_tinto$densidade)>3,]
df_tinto <- df_tinto[!abs(df_tinto$PH)>3,]
df_tinto <- df_tinto[!abs(df_tinto$sulfatos)>3,]
df_tinto <- df_tinto[!abs(df_tinto$grau_alcolico)>3,]Validando o Dado
É possivel notar que após a remoção dos outliers os dados se encontram mais normalizados
Antes
attach(df_base_tinto)
Rotulos_Colunas <-c( "acidez_fixa","acidez volatil" ,"acido citrico","acucar residual","cloretos","fsd","tsd","densidade",
"PH","sulfatos","grau alcolico","qualidade")
p_1 <- vector("list", length = length(Rotulos_Colunas)-2)
for(i in 2:12){
p_1[[i-1]] <- plot_ly(x = as.formula(df_base_tinto[i]), type = 'histogram', name = Rotulos_Colunas[i])
}
subplot(p_1, nrows = 4)Vinho Branco
outlier <- data.frame(matrix(ncol = 1, nrow = 1))
colnames(outlier)<-"tipo"
outlier$tipo = "Branco"
outlier$acidez_fixa <- count(df_branco[abs(df_branco$acidez_fixa)>3,])
outlier$acidez_volatil <-count(df_branco[abs(df_branco$acidez_volatil)>3,])
outlier$acido_citrico <-count(df_branco[abs(df_branco$acido_citrico)>3,])
outlier$acucar_residual <-count(df_branco[abs(df_branco$acucar_residual)>3,])
outlier$cloretos <-count(df_branco[abs(df_branco$cloretos)>3,])
outlier$fsd <-count(df_branco[abs(df_branco$fsd)>3,])
outlier$tsd <-count(df_branco[abs(df_branco$tsd)>3,])
outlier$densidade <-count(df_branco[abs(df_branco$densidade)>3,])
outlier$PH <-count(df_branco[abs(df_branco$PH)>3,])
outlier$sulfatos <-count(df_branco[abs(df_branco$sulfatos)>3,])
outlier$grau_alcolico <-count(df_branco[abs(df_branco$grau_alcolico)>3,])
summary(outlier) tipo acidez_fixa.n acidez_volatil.n acido_citrico.n acucar_residual.n cloretos.n fsd.n tsd.n densidade.n PH.n sulfatos.n grau_alcolico.n
Length:1 Min. :20 Min. :18 Min. :70 Min. :0 Min. :80 Min. :13 Min. :23 Min. :5 Min. :17 Min. :10 Min. :0
Class :character 1st Qu.:20 1st Qu.:18 1st Qu.:70 1st Qu.:0 1st Qu.:80 1st Qu.:13 1st Qu.:23 1st Qu.:5 1st Qu.:17 1st Qu.:10 1st Qu.:0
Mode :character Median :20 Median :18 Median :70 Median :0 Median :80 Median :13 Median :23 Median :5 Median :17 Median :10 Median :0
Mean :20 Mean :18 Mean :70 Mean :0 Mean :80 Mean :13 Mean :23 Mean :5 Mean :17 Mean :10 Mean :0
3rd Qu.:20 3rd Qu.:18 3rd Qu.:70 3rd Qu.:0 3rd Qu.:80 3rd Qu.:13 3rd Qu.:23 3rd Qu.:5 3rd Qu.:17 3rd Qu.:10 3rd Qu.:0
Max. :20 Max. :18 Max. :70 Max. :0 Max. :80 Max. :13 Max. :23 Max. :5 Max. :17 Max. :10 Max. :0 Encontramos 153 observações fora do padrão e iremos remover de nossa análise
Removendo os outliers
df_branco <- df_branco[!abs(df_branco$acidez_fixa)>3,]
df_branco <- df_branco[!abs(df_branco$acidez_volatil)>3,]
df_branco <- df_branco[!abs(df_branco$acido_citrico)>3,]
df_branco <- df_branco[!abs(df_branco$cloretos)>3,]
df_branco <- df_branco[!abs(df_branco$fsd)>3,]
df_branco <- df_branco[!abs(df_branco$tsd)>3,]
df_branco <- df_branco[!abs(df_branco$densidade)>3,]
df_branco <- df_branco[!abs(df_branco$PH)>3,]
df_branco <- df_branco[!abs(df_branco$sulfatos)>3,]Validando o Dado
Assim como no vinho tinto, temos a mesma percepção de com poucas extrações o dado ficou também mais proximo do normal
Antes
attach(df_base_branco)
Rotulos_Colunas <-c("id", "acidez_fixa","acidez volatil" ,"acido citrico","acucar residual","cloretos","fsd","tsd","densidade",
"PH","sulfatos","grau alcolico","qualidade","tipo")
p_1 <- vector("list", length = length(Rotulos_Colunas)-2)
for(i in 2:11){
p_1[[i-1]] <- plot_ly(x = as.formula(df_base_branco[i]), type = 'histogram', name = Rotulos_Colunas[i])
}
subplot(p_1, nrows = 4)Matriz de Correlação
Técnica
O primeiro passo para iniciar o processo de aplicação de modelos estatísticos é validar as correlações que possam indicar caracteristicas que determinam o fato.E neste caso precisamos saber quais das variáveis podem agregar qualidade ao vinho.
Regressão Linear
Técnica
Regressão linear é uma equação para se estimar a condicional (valor esperado) de uma variável y, dados os valores de algumas outras variáveis x.
Exemplo de regressão linear. A regressão, em geral, tem como objectivo tratar de um valor que não se consegue estimar inicialmente.
A regressão linear é chamada “linear” porque se considera que a relação da resposta às variáveis é uma função linear de alguns parâmetros. Os modelos de regressão que não são uma função linear dos parâmetros se chamam modelos de regressão não-linear. Sendo uma das primeiras formas de análise regressiva a ser estudada rigorosamente, e usada extensamente em aplicações práticas. Isso acontece porque modelos que dependem de forma linear dos seus parâmetros desconhecidos, são mais fáceis de ajustar que os modelos não-lineares aos seus parâmetros, e porque as propriedades estatísticas dos estimadores resultantes são fáceis de determinar.[1]
Formula
\[y_{i} = \alpha + \beta X_{i} + \varepsilon_{i}\]
onde:
\[y_{i}\]: Variável explicada (dependente); representa o que o modelo tentará prever \[\alpha\]: É uma constante, que representa a interceptação da reta com o eixo vertical; \[\beta\]: Representa a inclinação (coeficiente angular) em relação à variável explicativa; \[X_{i}\]: Variável explicativa (independente); \[\varepsilon _{i}}\]: Representa todos os factores residuais mais os possíveis erros de medição. O seu comportamento é aleatório, devido à natureza dos factores que encerra. Para que essa fórmula possa ser aplicada, os erros devem satisfazer determinadas hipóteses, que são: terem distribuição normal, com a mesma variância independentes e independentes da variável explicativa X, ou seja, i.i.d. (independentes e identicamente distribuídas).
Vinho Tinto
Separação dos Dados Treino e Teste
set.seed(1914) #seed relacionado ao ano de fundação do nosso amado e glorioso Palestra Itália
split <- sample.split(df_tinto$qualidade, SplitRatio = 0.8)
#dividindo o dataset para treino e teste
df_vinho_tinto_treino <- subset(df_tinto, split == TRUE)
df_vinho_tinto_teste <- subset(df_tinto, split == FALSE)Modelo Vinho Tinto
Modelo_01 <- lm(qualidade~ acidez_fixa+acidez_volatil+acido_citrico+acucar_residual+cloretos+densidade+fsd+grau_alcolico+PH+sulfatos+tsd,
data = df_vinho_tinto_treino)
precisao.tinto.rlinear = summary(Modelo_01)$r.squared * 100
summary(Modelo_01)
Call:
lm(formula = qualidade ~ acidez_fixa + acidez_volatil + acido_citrico +
acucar_residual + cloretos + densidade + fsd + grau_alcolico +
PH + sulfatos + tsd, data = df_vinho_tinto_treino)
Residuals:
Min 1Q Median 3Q Max
-2.91779 -0.42534 -0.02276 0.54255 2.23170
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.0005926 0.0240603 -0.025 0.9804
acidez_fixa 0.0989973 0.0644249 1.537 0.1247
acidez_volatil -0.2529691 0.0340139 -7.437 2.18e-13 ***
acido_citrico -0.0813844 0.0420323 -1.936 0.0531 .
acucar_residual 0.0337355 0.0340020 0.992 0.3214
cloretos -0.0292052 0.0330493 -0.884 0.3771
densidade -0.0807869 0.0650825 -1.241 0.2148
fsd 0.0604981 0.0432092 1.400 0.1618
grau_alcolico 0.3809766 0.0474714 8.025 2.77e-15 ***
PH -0.0952265 0.0457608 -2.081 0.0377 *
sulfatos 0.2302949 0.0296359 7.771 1.90e-14 ***
tsd -0.0877090 0.0452497 -1.938 0.0529 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.7686 on 1020 degrees of freedom
Multiple R-squared: 0.3984, Adjusted R-squared: 0.3919
F-statistic: 61.4 on 11 and 1020 DF, p-value: < 2.2e-16
Treino do Modelo
df_vinho_tinto_treino$Predicao.Qualidade = predict(Modelo_01, newdata = subset(df_vinho_tinto_treino, select=c(qualidade, acidez_fixa,acidez_volatil,acido_citrico,acucar_residual,cloretos,densidade,fsd,grau_alcolico,PH,sulfatos,tsd)))
treino.corr = round(cor(df_vinho_tinto_treino$Predicao.Qualidade, df_vinho_tinto_treino$qualidade), 2)
treino.RMSE = round(sqrt(mean((df_vinho_tinto_treino$Predicao.Qualidade - df_vinho_tinto_treino$qualidade)^2)))
treino.MAE = round(mean(abs(df_vinho_tinto_treino$Predicao.Qualidade - df_vinho_tinto_treino$qualidade)))
c(treino.corr ^ 2, treino.RMSE, treino.MAE)[1] 0.3969 1.0000 1.0000Teste do Modelo
df_vinho_tinto_teste$Predicao.Qualidade = predict(Modelo_01, newdata = subset(df_vinho_tinto_teste, select=c(qualidade, acidez_fixa,acidez_volatil,acido_citrico,acucar_residual,cloretos,densidade,fsd,grau_alcolico,PH,sulfatos,tsd)))
teste.corr = round(cor(df_vinho_tinto_teste$Predicao.Qualidade, df_vinho_tinto_teste$qualidade), 2)
teste.RMSE = round(sqrt(mean((df_vinho_tinto_teste$Predicao.Qualidade - df_vinho_tinto_teste$qualidade)^2)))
teste.MAE = round(mean(abs(df_vinho_tinto_teste$Predicao.Qualidade - df_vinho_tinto_teste$qualidade)))
c(teste.corr ^ 2, teste.RMSE, teste.MAE)[1] 0.3025 1.0000 1.0000Relacionamento da Variável “qualidade”
par(mfrow=c(1,2))
plot(df_tinto$qualidade, df_tinto$grau_alcolico, main = "qualidade vs grau_alcolico", xlab="qualidade", ylab = "grau_alcolico", col = 3, pch = 1)
plot(df_tinto$qualidade, df_tinto$acidez_volatil, main = "qualidade vs acidez_volatil", xlab="qualidade", ylab = "acidez_volatil", col = 3, pch = 1)
par(mfrow=c(1,2))
plot(df_tinto$qualidade, df_tinto$acido_citrico, main = "qualidade vs acido_citrico", xlab="qualidade", ylab = "acido_citrico", col = 3, pch = 1)
plot(df_tinto$qualidade, df_tinto$sulfatos, main = "qualidade vs sulfatos", xlab="qualidade", ylab = "sulfatos", col = 3, pch = 1)
Vinho Branco
Separação dos Dados Treino e Teste
set.seed(1914) #seed relacionado ao ano de fundação do nosso amado e glorioso Palestra Itália
split <- sample.split(df_branco$qualidade, SplitRatio = 0.8)
#dividindo o dataset para treino e teste
df_vinho_branco_treino <- subset(df_branco, split == TRUE)
df_vinho_branco_teste <- subset(df_branco, split == FALSE)Modelo Vinho Branco
Modelo_01 <- lm(qualidade~ acidez_fixa+acidez_volatil+acido_citrico+acucar_residual+cloretos+densidade+fsd+grau_alcolico+PH+sulfatos+tsd,
data = df_vinho_branco_treino)
precisao.branco.rlinear = summary(Modelo_01)$r.squared * 100
summary(Modelo_01)
Call:
lm(formula = qualidade ~ acidez_fixa + acidez_volatil + acido_citrico +
acucar_residual + cloretos + densidade + fsd + grau_alcolico +
PH + sulfatos + tsd, data = df_vinho_branco_treino)
Residuals:
Min 1Q Median 3Q Max
-3.7158 -0.5311 -0.0277 0.5226 3.4384
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.008325 0.015059 0.553 0.58045
acidez_fixa 0.068133 0.023397 2.912 0.00362 **
acidez_volatil -0.150709 0.016759 -8.993 < 2e-16 ***
acido_citrico 0.053721 0.018986 2.829 0.00469 **
acucar_residual 0.344473 0.036732 9.378 < 2e-16 ***
cloretos -0.109751 0.020807 -5.275 1.43e-07 ***
densidade -0.440484 0.061300 -7.186 8.43e-13 ***
fsd 0.186139 0.021158 8.797 < 2e-16 ***
grau_alcolico 0.212618 0.039284 5.412 6.72e-08 ***
PH 0.138252 0.020761 6.659 3.27e-11 ***
sulfatos 0.080651 0.016046 5.026 5.30e-07 ***
tsd -0.062914 0.024020 -2.619 0.00886 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.8166 on 2954 degrees of freedom
Multiple R-squared: 0.3135, Adjusted R-squared: 0.3109
F-statistic: 122.6 on 11 and 2954 DF, p-value: < 2.2e-16
Treino do Modelo
df_vinho_branco_treino$Predicao.Qualidade = predict(Modelo_01, newdata = subset(df_vinho_branco_treino, select=c(qualidade, acidez_fixa, acidez_volatil, acido_citrico, acucar_residual, cloretos, densidade, fsd, grau_alcolico, PH, sulfatos, tsd)))
treino.corr = round(cor(df_vinho_branco_treino$Predicao.Qualidade, df_vinho_branco_treino$qualidade), 2)
treino.RMSE = round(sqrt(mean((df_vinho_branco_treino$Predicao.Qualidade - df_vinho_branco_treino$qualidade)^2)))
treino.MAE = round(mean(abs(df_vinho_branco_treino$Predicao.Qualidade - df_vinho_branco_treino$qualidade)))
c(treino.corr ^ 2, treino.RMSE, treino.MAE)[1] 0.3136 1.0000 1.0000Teste do Modelo
df_vinho_branco_teste$Predicao.Qualidade = predict(Modelo_01, newdata = subset(df_vinho_branco_teste, select=c(qualidade, acidez_fixa, acidez_volatil, acido_citrico, acucar_residual, cloretos, densidade, fsd, grau_alcolico, PH, sulfatos, tsd)))
teste.corr = round(cor(df_vinho_branco_teste$Predicao.Qualidade, df_vinho_branco_teste$qualidade), 2)
teste.RMSE = round(sqrt(mean((df_vinho_branco_teste$Predicao.Qualidade - df_vinho_branco_teste$qualidade)^2)))
teste.MAE = round(mean(abs(df_vinho_branco_teste$Predicao.Qualidade - df_vinho_branco_teste$qualidade)))
c(teste.corr ^ 2, teste.RMSE, teste.MAE)[1] 0.3136 1.0000 1.0000Relacionamento da Variável “qualidade”
par(mfrow=c(1,2))
plot(df_branco$qualidade, df_branco$grau_alcolico, main = "qualidade vs grau_alcolico", xlab="qualidade", ylab = "grau_alcolico", col = 3, pch = 1)
plot(df_branco$qualidade, df_branco$acidez_volatil, main = "qualidade vs acidez_volatil", xlab="qualidade", ylab = "acidez_volatil", col = 3, pch = 1)
par(mfrow=c(1,2))
plot(df_branco$qualidade, df_branco$acido_citrico, main = "qualidade vs acido_citrico", xlab="qualidade", ylab = "acido_citrico", col = 3, pch = 1)
plot(df_branco$qualidade, df_branco$sulfatos, main = "qualidade vs sulfatos", xlab="qualidade", ylab = "sulfatos", col = 3, pch = 1)
par(mfrow=c(1,2))
plot(df_branco$qualidade, df_branco$acidez_fixa, main = "qualidade vs acidez_fixa", xlab="qualidade", ylab = "acidez_fixa", col = 3, pch = 1)
plot(df_branco$qualidade, df_branco$acucar_residual, main = "qualidade vs acucar_residual", xlab="qualidade", ylab = "acucar_residual", col = 3, pch = 1)
par(mfrow=c(1,2))
plot(df_branco$qualidade, df_branco$cloretos, main = "qualidade vs cloretos", xlab="qualidade", ylab = "cloretos", col = 3, pch = 1)
plot(df_branco$qualidade, df_branco$densidade, main = "qualidade vs densidade", xlab="qualidade", ylab = "densidade", col = 3, pch = 1)
par(mfrow=c(1,2))
plot(df_branco$qualidade, df_branco$fsd, main = "qualidade vs fsd", xlab="qualidade", ylab = "fsd", col = 3, pch = 1)
plot(df_branco$qualidade, df_branco$PH, main = "qualidade vs PH", xlab="qualidade", ylab = "PH", col = 3, pch = 1)
par(mfrow=c(1,2))
plot(df_branco$qualidade, df_branco$tsd, main = "qualidade vs tsd", xlab="qualidade", ylab = "tsd", col = 3, pch = 1)
Árvore de Regressão
Técnica
É muito similar a árvore de decisão, pois segue a mesma ideia: um conjunto de nós de DECISÃO/PERGUNTAS partindo de exemplos.
A única diferença é que a resposta é um número ao invés de uma categoria.
A obtenção de árvores de regressão usando o R é feita por meio da função rpart, tal como nas árvores de decisão.
Vinho Tinto
RT_Modelo_01 <- rpart(qualidade ~ acidez_fixa+acidez_volatil+acido_citrico+acucar_residual+cloretos+densidade+fsd+grau_alcolico+PH+sulfatos+tsd, data = df_vinho_tinto_treino)
summary(RT_Modelo_01)Call:
rpart(formula = qualidade ~ acidez_fixa + acidez_volatil + acido_citrico +
acucar_residual + cloretos + densidade + fsd + grau_alcolico +
PH + sulfatos + tsd, data = df_vinho_tinto_treino)
n= 1032
CP nsplit rel error xerror xstd
1 0.18965507 0 1.0000000 1.0010049 0.04793595
2 0.06016577 1 0.8103449 0.8410342 0.04473512
3 0.03987222 2 0.7501792 0.8079763 0.04148181
4 0.03328510 3 0.7103069 0.8159455 0.04190225
5 0.02331796 4 0.6770218 0.7696630 0.03910886
6 0.02114413 5 0.6537039 0.7561527 0.03786086
7 0.01996104 6 0.6325598 0.7528794 0.03825171
8 0.01130783 7 0.6125987 0.7274491 0.03750090
9 0.01087334 8 0.6012909 0.7378201 0.03763991
10 0.01046919 9 0.5904175 0.7283979 0.03759222
11 0.01016485 10 0.5799484 0.7233240 0.03756813
12 0.01000000 11 0.5697835 0.7262831 0.03763340
Variable importance
grau_alcolico sulfatos densidade acidez_volatil tsd acido_citrico acidez_fixa PH cloretos fsd acucar_residual
33 15 11 10 8 6 6 5 4 2 1
Node number 1: 1032 observations, complexity param=0.1896551
mean=0.002004876, MSE=0.9705261
left son=2 (766 obs) right son=3 (266 obs)
Primary splits:
grau_alcolico < 0.5396166 to the left, improve=0.18965510, (0 missing)
sulfatos < 0.1511739 to the left, improve=0.14816780, (0 missing)
acidez_volatil < 0.220747 to the right, improve=0.13010950, (0 missing)
acido_citrico < 0.1147807 to the left, improve=0.09954917, (0 missing)
densidade < -0.6131584 to the right, improve=0.06713087, (0 missing)
Surrogate splits:
densidade < -0.6779414 to the right, agree=0.833, adj=0.353, (0 split)
cloretos < -1.186951 to the right, agree=0.763, adj=0.079, (0 split)
acidez_fixa < -2.015744 to the right, agree=0.753, adj=0.041, (0 split)
acido_citrico < 1.854948 to the left, agree=0.749, adj=0.026, (0 split)
PH < 1.568081 to the left, agree=0.747, adj=0.019, (0 split)
Node number 2: 766 observations, complexity param=0.06016577
mean=-0.2508156, MSE=0.7437246
left son=4 (492 obs) right son=5 (274 obs)
Primary splits:
sulfatos < 0.1511739 to the left, improve=0.10577800, (0 missing)
acidez_volatil < -0.9119238 to the right, improve=0.10047880, (0 missing)
grau_alcolico < -0.397931 to the left, improve=0.07528245, (0 missing)
acido_citrico < 0.01241791 to the left, improve=0.05165566, (0 missing)
tsd < 1.151455 to the right, improve=0.04508008, (0 missing)
Surrogate splits:
acidez_volatil < -0.7552291 to the right, agree=0.698, adj=0.157, (0 split)
acido_citrico < 0.6265947 to the left, agree=0.693, adj=0.142, (0 split)
acidez_fixa < 1.193824 to the left, agree=0.685, adj=0.120, (0 split)
grau_alcolico < 0.12061 to the left, agree=0.680, adj=0.106, (0 split)
densidade < 0.8837916 to the left, agree=0.663, adj=0.058, (0 split)
Node number 3: 266 observations, complexity param=0.03987222
mean=0.7300519, MSE=0.9095286
left son=6 (110 obs) right son=7 (156 obs)
Primary splits:
sulfatos < 0.07726951 to the left, improve=0.1650667, (0 missing)
acido_citrico < 0.1147807 to the left, improve=0.1448919, (0 missing)
PH < 0.3828312 to the right, improve=0.1232959, (0 missing)
acidez_fixa < -0.7048986 to the left, improve=0.1113672, (0 missing)
acidez_volatil < 0.3648637 to the right, improve=0.1021026, (0 missing)
Surrogate splits:
acidez_fixa < -0.6272436 to the left, agree=0.673, adj=0.209, (0 split)
acido_citrico < 0.06359931 to the left, agree=0.662, adj=0.182, (0 split)
PH < 0.7642008 to the right, agree=0.658, adj=0.173, (0 split)
tsd < -1.410368 to the left, agree=0.650, adj=0.155, (0 split)
densidade < -1.321643 to the left, agree=0.643, adj=0.136, (0 split)
Node number 4: 492 observations, complexity param=0.01996104
mean=-0.4601288, MSE=0.6152957
left son=8 (26 obs) right son=9 (466 obs)
Primary splits:
acidez_volatil < 1.66197 to the right, improve=0.06604212, (0 missing)
sulfatos < -0.4230589 to the left, improve=0.04278913, (0 missing)
tsd < -1.30981 to the left, improve=0.03373064, (0 missing)
grau_alcolico < -0.397931 to the left, improve=0.02542169, (0 missing)
fsd < -0.7829573 to the left, improve=0.02039282, (0 missing)
Node number 5: 274 observations, complexity param=0.0332851
mean=0.1250314, MSE=0.7544035
left son=10 (35 obs) right son=11 (239 obs)
Primary splits:
tsd < 1.134522 to the right, improve=0.16128080, (0 missing)
acidez_volatil < -0.9119238 to the right, improve=0.15608930, (0 missing)
grau_alcolico < -0.4192402 to the left, improve=0.11918110, (0 missing)
cloretos < 0.6134846 to the right, improve=0.08898052, (0 missing)
acidez_fixa < 0.5791973 to the left, improve=0.06934507, (0 missing)
Surrogate splits:
acucar_residual < 2.12965 to the right, agree=0.880, adj=0.057, (0 split)
fsd < 1.870502 to the right, agree=0.876, adj=0.029, (0 split)
Node number 6: 110 observations, complexity param=0.02114413
mean=0.268624, MSE=0.9403877
left son=12 (58 obs) right son=13 (52 obs)
Primary splits:
PH < 0.3828312 to the right, improve=0.20472790, (0 missing)
acidez_volatil < -0.06930554 to the right, improve=0.20256360, (0 missing)
acido_citrico < 0.1659621 to the left, improve=0.17148800, (0 missing)
acidez_fixa < -0.7048986 to the left, improve=0.15974650, (0 missing)
grau_alcolico < 0.9884923 to the left, improve=0.05209789, (0 missing)
Surrogate splits:
acidez_fixa < -0.4770287 to the left, agree=0.882, adj=0.750, (0 split)
acido_citrico < -0.0387635 to the left, agree=0.882, adj=0.750, (0 split)
acidez_volatil < -0.4915943 to the right, agree=0.809, adj=0.596, (0 split)
fsd < -0.4362771 to the right, agree=0.664, adj=0.288, (0 split)
cloretos < -0.7378493 to the left, agree=0.655, adj=0.269, (0 split)
Node number 7: 156 observations, complexity param=0.01016485
mean=1.055418, MSE=0.6317732
left son=14 (56 obs) right son=15 (100 obs)
Primary splits:
grau_alcolico < 0.9884923 to the left, improve=0.10330040, (0 missing)
fsd < 0.5391907 to the right, improve=0.08807679, (0 missing)
tsd < 0.06330731 to the right, improve=0.07717586, (0 missing)
densidade < -1.812733 to the right, improve=0.04707774, (0 missing)
acidez_volatil < -0.3662575 to the right, improve=0.03931849, (0 missing)
Surrogate splits:
acidez_volatil < -2.372357 to the left, agree=0.654, adj=0.036, (0 split)
acido_citrico < 0.1659621 to the left, agree=0.654, adj=0.036, (0 split)
PH < -0.8713243 to the left, agree=0.654, adj=0.036, (0 split)
fsd < 1.572158 to the right, agree=0.647, adj=0.018, (0 split)
tsd < 1.315958 to the right, agree=0.647, adj=0.018, (0 split)
Node number 8: 26 observations
mean=-1.313541, MSE=1.085255
Node number 9: 466 observations, complexity param=0.01130783
mean=-0.4125135, MSE=0.5461722
left son=18 (300 obs) right son=19 (166 obs)
Primary splits:
grau_alcolico < -0.397931 to the left, improve=0.04449903, (0 missing)
sulfatos < -0.4230589 to the left, improve=0.03467342, (0 missing)
acidez_volatil < 0.746838 to the right, improve=0.02965481, (0 missing)
tsd < -1.30981 to the left, improve=0.02423048, (0 missing)
PH < 1.44634 to the right, improve=0.01583774, (0 missing)
Surrogate splits:
densidade < -0.6671426 to the right, agree=0.680, adj=0.102, (0 split)
cloretos < -0.514703 to the right, agree=0.663, adj=0.054, (0 split)
tsd < -1.905212 to the right, agree=0.661, adj=0.048, (0 split)
acidez_fixa < -1.492943 to the right, agree=0.657, adj=0.036, (0 split)
acidez_volatil < -1.113273 to the right, agree=0.652, adj=0.024, (0 split)
Node number 10: 35 observations
mean=-0.7864715, MSE=0.1371291
Node number 11: 239 observations, complexity param=0.02331796
mean=0.2585151, MSE=0.7053107
left son=22 (173 obs) right son=23 (66 obs)
Primary splits:
acidez_volatil < -0.9658398 to the right, improve=0.13854760, (0 missing)
grau_alcolico < -0.4192402 to the left, improve=0.10157690, (0 missing)
acido_citrico < -1.062392 to the left, improve=0.09335675, (0 missing)
PH < 1.07694 to the right, improve=0.08085371, (0 missing)
cloretos < 0.6285956 to the right, improve=0.06499344, (0 missing)
Surrogate splits:
acido_citrico < 0.8313204 to the left, agree=0.774, adj=0.182, (0 split)
cloretos < -0.8579218 to the right, agree=0.745, adj=0.076, (0 split)
fsd < 1.770708 to the left, agree=0.741, adj=0.061, (0 split)
PH < -2.202895 to the right, agree=0.736, adj=0.045, (0 split)
tsd < -1.764199 to the right, agree=0.736, adj=0.045, (0 split)
Node number 12: 58 observations
mean=-0.1468364, MSE=0.8054716
Node number 13: 52 observations
mean=0.7320222, MSE=0.6836096
Node number 14: 56 observations
mean=0.7140381, MSE=0.6231425
Node number 15: 100 observations
mean=1.24659, MSE=0.534797
Node number 18: 300 observations
mean=-0.5284803, MSE=0.4319252
Node number 19: 166 observations, complexity param=0.01087334
mean=-0.2029351, MSE=0.6844154
left son=38 (24 obs) right son=39 (142 obs)
Primary splits:
tsd < -1.30981 to the left, improve=0.09585663, (0 missing)
fsd < -0.7829573 to the left, improve=0.07165548, (0 missing)
densidade < 0.7954522 to the left, improve=0.06646794, (0 missing)
sulfatos < -0.3321776 to the left, improve=0.04341652, (0 missing)
PH < 1.38521 to the right, improve=0.03526601, (0 missing)
Surrogate splits:
fsd < -1.302597 to the left, agree=0.904, adj=0.333, (0 split)
cloretos < -1.117557 to the left, agree=0.886, adj=0.208, (0 split)
sulfatos < -2.33142 to the left, agree=0.867, adj=0.083, (0 split)
acucar_residual < -1.978159 to the left, agree=0.861, adj=0.042, (0 split)
PH < 1.749415 to the right, agree=0.861, adj=0.042, (0 split)
Node number 22: 173 observations, complexity param=0.01046919
mean=0.06543446, MSE=0.595937
left son=44 (83 obs) right son=45 (90 obs)
Primary splits:
grau_alcolico < -0.4192402 to the left, improve=0.10170760, (0 missing)
acidez_volatil < 0.220747 to the right, improve=0.07798942, (0 missing)
acido_citrico < -1.164754 to the left, improve=0.07776564, (0 missing)
PH < 0.8271122 to the right, improve=0.06725018, (0 missing)
cloretos < 1.25143 to the right, improve=0.05525110, (0 missing)
Surrogate splits:
acido_citrico < -0.0387635 to the left, agree=0.647, adj=0.265, (0 split)
acidez_fixa < 0.3607951 to the left, agree=0.630, adj=0.229, (0 split)
acidez_volatil < 0.3130046 to the right, agree=0.618, adj=0.205, (0 split)
densidade < -0.122649 to the right, agree=0.613, adj=0.193, (0 split)
acucar_residual < 0.3640832 to the left, agree=0.595, adj=0.157, (0 split)
Node number 23: 66 observations
mean=0.7646204, MSE=0.6381406
Node number 38: 24 observations
mean=-0.8259659, MSE=1.101106
Node number 39: 142 observations
mean=-0.0976341, MSE=0.5372948
Node number 44: 83 observations
mean=-0.1909308, MSE=0.4815758
Node number 45: 90 observations
mean=0.3018602, MSE=0.5848951 
O Modelo apresentado acima teve um desepenho melhor que Regressão Linear Observamos que a variavel Grau Alcoolico é a variavel que possui o maior peso pois ela está no node mais alto da arvore.
Análise da Qualidade do Modelo (Matriz de Confusão)
RT_preditor <- predict(RT_Modelo_01, newdata = df_vinho_tinto_teste)
RT_Valores_Corte <- as.factor(ifelse(RT_preditor > 6,1,0))
confusionMatrix(RT_Valores_Corte, df_vinho_tinto_teste$GrupoQualidade)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 224 35
1 0 0
Accuracy : 0.8649
95% CI : (0.8171, 0.904)
No Information Rate : 0.8649
P-Value [Acc > NIR] : 0.5449
Kappa : 0
Mcnemar's Test P-Value : 9.081e-09
Sensitivity : 1.0000
Specificity : 0.0000
Pos Pred Value : 0.8649
Neg Pred Value : NaN
Prevalence : 0.8649
Detection Rate : 0.8649
Detection Prevalence : 1.0000
Balanced Accuracy : 0.5000
'Positive' Class : 0
Vinho Branco
RT_Modelo_01 <- rpart(qualidade ~ acidez_fixa+acidez_volatil+acido_citrico+acucar_residual+cloretos+densidade+fsd+grau_alcolico+PH+sulfatos+tsd, data = df_vinho_branco_treino)
summary(RT_Modelo_01)Call:
rpart(formula = qualidade ~ acidez_fixa + acidez_volatil + acido_citrico +
acucar_residual + cloretos + densidade + fsd + grau_alcolico +
PH + sulfatos + tsd, data = df_vinho_branco_treino)
n= 2966
CP nsplit rel error xerror xstd
1 0.17619501 0 1.0000000 1.0007017 0.02704089
2 0.04145691 1 0.8238050 0.8253886 0.02465195
3 0.02600484 2 0.7823481 0.7844375 0.02429231
4 0.01758769 3 0.7563432 0.7659587 0.02353418
5 0.01228332 4 0.7387555 0.7575937 0.02327931
6 0.01000000 5 0.7264722 0.7399149 0.02261242
Variable importance
grau_alcolico densidade cloretos tsd acidez_volatil fsd acucar_residual sulfatos acido_citrico PH
36 23 12 8 8 5 5 1 1 1
Node number 1: 2966 observations, complexity param=0.176195
mean=0.02317861, MSE=0.9674341
left son=2 (1800 obs) right son=3 (1166 obs)
Primary splits:
grau_alcolico < 0.3424558 to the left, improve=0.17619500, (0 missing)
densidade < -0.6974774 to the right, improve=0.12381530, (0 missing)
cloretos < -0.01120033 to the right, improve=0.09321832, (0 missing)
tsd < 0.5387351 to the right, improve=0.04655035, (0 missing)
acido_citrico < -0.8149336 to the left, improve=0.03543393, (0 missing)
Surrogate splits:
densidade < -0.6316146 to the right, agree=0.863, adj=0.653, (0 split)
cloretos < -0.2502617 to the right, agree=0.741, adj=0.342, (0 split)
tsd < -0.4792879 to the right, agree=0.681, adj=0.189, (0 split)
acucar_residual < 0.2869475 to the right, agree=0.662, adj=0.140, (0 split)
sulfatos < -1.098038 to the right, agree=0.620, adj=0.034, (0 split)
Node number 2: 1800 observations, complexity param=0.04145691
mean=-0.3091139, MSE=0.706894
left son=4 (949 obs) right son=5 (851 obs)
Primary splits:
acidez_volatil < -0.07404229 to the right, improve=0.09348947, (0 missing)
fsd < -1.413899 to the left, improve=0.04482435, (0 missing)
grau_alcolico < -0.2856169 to the left, improve=0.04101271, (0 missing)
cloretos < 0.5163293 to the right, improve=0.03254169, (0 missing)
PH < 0.8886209 to the left, improve=0.03244542, (0 missing)
Surrogate splits:
tsd < 0.5604489 to the right, agree=0.612, adj=0.179, (0 split)
acido_citrico < -0.5696854 to the left, agree=0.581, adj=0.113, (0 split)
grau_alcolico < -0.3482213 to the left, agree=0.577, adj=0.105, (0 split)
densidade < 0.1770835 to the right, agree=0.576, adj=0.103, (0 split)
PH < 0.7082788 to the left, agree=0.570, adj=0.090, (0 split)
Node number 3: 1166 observations, complexity param=0.02600484
mean=0.5361516, MSE=0.9360418
left son=6 (608 obs) right son=7 (558 obs)
Primary splits:
grau_alcolico < 1.073028 to the left, improve=0.06836801, (0 missing)
fsd < -1.608991 to the left, improve=0.05935855, (0 missing)
acucar_residual < -1.318872 to the left, improve=0.02510477, (0 missing)
densidade < -0.9024215 to the right, improve=0.02276161, (0 missing)
tsd < -1.763242 to the left, improve=0.02232176, (0 missing)
Surrogate splits:
densidade < -1.059489 to the right, agree=0.725, adj=0.425, (0 split)
acidez_volatil < 0.03761714 to the left, agree=0.635, adj=0.237, (0 split)
cloretos < -0.519033 to the right, agree=0.633, adj=0.233, (0 split)
acucar_residual < -1.114568 to the left, agree=0.551, adj=0.063, (0 split)
tsd < -0.1643378 to the right, agree=0.551, adj=0.063, (0 split)
Node number 4: 949 observations, complexity param=0.01228332
mean=-0.5525529, MSE=0.6252677
left son=8 (135 obs) right son=9 (814 obs)
Primary splits:
fsd < -1.063122 to the left, improve=0.05939858, (0 missing)
cloretos < 0.5163293 to the right, improve=0.04192878, (0 missing)
PH < 0.9476561 to the left, improve=0.02471973, (0 missing)
acidez_volatil < 0.3491317 to the right, improve=0.02443427, (0 missing)
grau_alcolico < -0.1639063 to the left, improve=0.02399822, (0 missing)
Surrogate splits:
tsd < -0.8873303 to the left, agree=0.887, adj=0.207, (0 split)
densidade < -0.9613 to the left, agree=0.862, adj=0.030, (0 split)
acidez_fixa < 2.86523 to the right, agree=0.861, adj=0.022, (0 split)
acucar_residual < -1.59975 to the left, agree=0.860, adj=0.015, (0 split)
PH < -2.257615 to the left, agree=0.859, adj=0.007, (0 split)
Node number 5: 851 observations
mean=-0.03764077, MSE=0.6581355
Node number 6: 608 observations, complexity param=0.01758769
mean=0.2938036, MSE=0.9043135
left son=12 (43 obs) right son=13 (565 obs)
Primary splits:
fsd < -1.608991 to the left, improve=0.09178650, (0 missing)
acido_citrico < -0.8149336 to the left, improve=0.03930066, (0 missing)
acidez_volatil < 1.657868 to the right, improve=0.03153874, (0 missing)
tsd < -1.553351 to the left, improve=0.02545143, (0 missing)
acidez_fixa < 0.3004013 to the right, improve=0.02138791, (0 missing)
Surrogate splits:
tsd < -2.452791 to the left, agree=0.941, adj=0.163, (0 split)
Node number 7: 558 observations
mean=0.8002153, MSE=0.8368882
Node number 8: 135 observations
mean=-1.025776, MSE=0.6297488
Node number 9: 814 observations
mean=-0.4740699, MSE=0.5812249
Node number 12: 43 observations
mean=-0.7505292, MSE=1.244715
Node number 13: 565 observations
mean=0.3732838, MSE=0.789086 
Nota se que para determinar a qualidade do vinho branco utiliza-se menos variáveis que para vinho tinto
RT_preditor <- predict(RT_Modelo_01, newdata = df_vinho_branco_teste)
RT_Valores_Corte <- as.factor(ifelse(RT_preditor > 6,1,0))
confusionMatrix(RT_Valores_Corte, df_vinho_branco_teste$GrupoQualidade)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 583 159
1 0 0
Accuracy : 0.7857
95% CI : (0.7544, 0.8147)
No Information Rate : 0.7857
P-Value [Acc > NIR] : 0.5212
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 1.0000
Specificity : 0.0000
Pos Pred Value : 0.7857
Neg Pred Value : NaN
Prevalence : 0.7857
Detection Rate : 0.7857
Detection Prevalence : 1.0000
Balanced Accuracy : 0.5000
'Positive' Class : 0
Árvore de Decisão
Técnica
É muito utilizada para aprendizagem indutiva e é extremamente prática.
O conhecimento da Árvore de Decisão será baseado em uma estrutura de árvore para assim podermos realizar decisão. Porém, caso não queira representar em estruturá de árvores, pode ser facilmente representada por regras “se/então”. Pode-se utilizar tanto em problemas supervisionados quanto não supervisionados.
A árvore decisão também consegue descobrir quais são os atributos de maior importância para predição formando uma estrutura de nós.
A base é a mesma da árvore de regressão.
Classe de algoritmos de aprendizado baseado na árvore de decisão: ID3(“top-down”), C4.5 etc.
É importante ressaltar que uanto menor a árvore, melhor será a indução. Isso basicamente quer dizer que: caso fique grande, pode cair num problema de overfitting (“100% de acerto”).
Outra coisa que precisa-se lembrar em uma Árvore de Decisão é a entropia, a qual diz o quanto um conjunto de dados aleatório está “impuro”. E sempre varia entre 0 e 1, de acordo com a proporção de +/- no conjunto. Vale lembrar que a entropia é importante para o cálculo de ganho de informação para a árvore.
A entropia (binária) é dada pela seguinte fórmula:
\[Entropia(S) = -\sum p_{+} log_{2} p_{+} - p_{-} log_{2} p_{-}\]
onde:
S: coleção S contendo exemplos p(+): proporção de exemplos positivos em S; p(-): proporção de exemplos negativos em S
Referencia: http://web.tecnico.ulisboa.pt/ana.freitas/bioinformatics.ath.cx/bioinformatics.ath.cx/indexf23d.html?id=199
Vinho Tinto
DT_Modelo01 <-rpart(GrupoQualidade ~ acidez_fixa+acidez_volatil+acido_citrico+acucar_residual+cloretos+densidade+fsd+grau_alcolico+PH+sulfatos+tsd, data = df_vinho_tinto_treino)
summary(DT_Modelo01)Call:
rpart(formula = GrupoQualidade ~ acidez_fixa + acidez_volatil +
acido_citrico + acucar_residual + cloretos + densidade +
fsd + grau_alcolico + PH + sulfatos + tsd, data = df_vinho_tinto_treino)
n= 1032
CP nsplit rel error xerror xstd
1 0.10071942 0 1.0000000 1.0000000 0.07890027
2 0.05035971 2 0.7985612 0.8489209 0.07354607
3 0.02158273 3 0.7482014 0.8345324 0.07299987
4 0.01918465 5 0.7050360 0.8920863 0.07514483
5 0.01438849 8 0.6474820 0.9352518 0.07668674
6 0.01000000 9 0.6330935 0.9424460 0.07693844
Variable importance
grau_alcolico densidade sulfatos acidez_volatil fsd tsd PH acido_citrico acidez_fixa cloretos
30 11 9 8 8 8 8 7 7 2
Node number 1: 1032 observations, complexity param=0.1007194
predicted class=0 expected loss=0.1346899 P(node) =1
class counts: 893 139
probabilities: 0.865 0.135
left son=2 (868 obs) right son=3 (164 obs)
Primary splits:
grau_alcolico < 0.9884923 to the left, improve=42.14039, (0 missing)
sulfatos < 0.424181 to the left, improve=26.51461, (0 missing)
acidez_volatil < -0.7552291 to the right, improve=24.87296, (0 missing)
acido_citrico < 0.2171435 to the left, improve=19.98735, (0 missing)
densidade < -0.7535512 to the right, improve=13.72150, (0 missing)
Surrogate splits:
densidade < -1.35958 to the right, agree=0.875, adj=0.213, (0 split)
acidez_fixa < -2.188553 to the right, agree=0.847, adj=0.037, (0 split)
cloretos < -1.912024 to the right, agree=0.844, adj=0.018, (0 split)
PH < 2.806385 to the left, agree=0.843, adj=0.012, (0 split)
tsd < 2.087083 to the left, agree=0.843, adj=0.012, (0 split)
Node number 2: 868 observations, complexity param=0.01918465
predicted class=0 expected loss=0.07258065 P(node) =0.8410853
class counts: 805 63
probabilities: 0.927 0.073
left son=4 (694 obs) right son=5 (174 obs)
Primary splits:
acidez_volatil < -0.7552291 to the right, improve=11.571490, (0 missing)
sulfatos < 0.3591132 to the left, improve= 8.193247, (0 missing)
grau_alcolico < 0.01161628 to the left, improve= 6.779079, (0 missing)
acido_citrico < 0.01241791 to the left, improve= 6.241852, (0 missing)
cloretos < -0.623591 to the right, improve= 4.745422, (0 missing)
Surrogate splits:
acido_citrico < 0.8313204 to the left, agree=0.804, adj=0.023, (0 split)
acucar_residual < 2.637203 to the left, agree=0.802, adj=0.011, (0 split)
fsd < 2.063933 to the left, agree=0.802, adj=0.011, (0 split)
PH < -2.202895 to the right, agree=0.802, adj=0.011, (0 split)
sulfatos < 2.418451 to the left, agree=0.802, adj=0.011, (0 split)
Node number 3: 164 observations, complexity param=0.1007194
predicted class=0 expected loss=0.4634146 P(node) =0.1589147
class counts: 88 76
probabilities: 0.537 0.463
left son=6 (82 obs) right son=7 (82 obs)
Primary splits:
sulfatos < 0.424181 to the left, improve=14.097560, (0 missing)
acidez_fixa < -0.1285656 to the left, improve= 7.866123, (0 missing)
PH < 0.3828312 to the right, improve= 7.527143, (0 missing)
acido_citrico < 0.2171435 to the left, improve= 7.527143, (0 missing)
acidez_volatil < -0.126957 to the right, improve= 5.504315, (0 missing)
Surrogate splits:
acido_citrico < 0.06359931 to the left, agree=0.646, adj=0.293, (0 split)
acidez_fixa < -0.6272436 to the left, agree=0.640, adj=0.280, (0 split)
densidade < -1.432767 to the left, agree=0.610, adj=0.220, (0 split)
tsd < -1.410368 to the left, agree=0.591, adj=0.183, (0 split)
fsd < 0.371857 to the left, agree=0.579, adj=0.159, (0 split)
Node number 4: 694 observations
predicted class=0 expected loss=0.03170029 P(node) =0.6724806
class counts: 672 22
probabilities: 0.968 0.032
Node number 5: 174 observations, complexity param=0.01918465
predicted class=0 expected loss=0.2356322 P(node) =0.1686047
class counts: 133 41
probabilities: 0.764 0.236
left son=10 (110 obs) right son=11 (64 obs)
Primary splits:
grau_alcolico < 0.2741428 to the left, improve=5.894070, (0 missing)
cloretos < -0.623591 to the right, improve=5.078161, (0 missing)
tsd < 0.4165548 to the right, improve=4.833333, (0 missing)
densidade < -1.004914 to the right, improve=4.789272, (0 missing)
sulfatos < 0.4872838 to the left, improve=4.490395, (0 missing)
Surrogate splits:
densidade < -0.2464966 to the right, agree=0.759, adj=0.344, (0 split)
tsd < -1.764199 to the right, agree=0.678, adj=0.125, (0 split)
acido_citrico < 1.803767 to the left, agree=0.649, adj=0.047, (0 split)
fsd < -1.90854 to the right, agree=0.644, adj=0.031, (0 split)
acucar_residual < 1.737718 to the left, agree=0.638, adj=0.016, (0 split)
Node number 6: 82 observations, complexity param=0.02158273
predicted class=0 expected loss=0.2560976 P(node) =0.07945736
class counts: 61 21
probabilities: 0.744 0.256
left son=12 (55 obs) right son=13 (27 obs)
Primary splits:
acido_citrico < 0.8825018 to the left, improve=5.544239, (0 missing)
acidez_fixa < 0.1256083 to the left, improve=4.746402, (0 missing)
PH < -0.2021667 to the right, improve=4.746402, (0 missing)
tsd < -1.215976 to the right, improve=4.511404, (0 missing)
cloretos < 0.3850831 to the left, improve=3.732539, (0 missing)
Surrogate splits:
acidez_fixa < 0.5791973 to the left, agree=0.902, adj=0.704, (0 split)
PH < -0.2021667 to the right, agree=0.866, adj=0.593, (0 split)
densidade < -0.5807761 to the left, agree=0.817, adj=0.444, (0 split)
acidez_volatil < -0.7552291 to the right, agree=0.756, adj=0.259, (0 split)
cloretos < -0.2402179 to the left, agree=0.756, adj=0.259, (0 split)
Node number 7: 82 observations, complexity param=0.05035971
predicted class=1 expected loss=0.3292683 P(node) =0.07945736
class counts: 27 55
probabilities: 0.329 0.671
left son=14 (25 obs) right son=15 (57 obs)
Primary splits:
fsd < 0.5391907 to the right, improve=6.945126, (0 missing)
grau_alcolico < 1.816099 to the left, improve=3.483248, (0 missing)
tsd < 0.2507296 to the right, improve=2.368370, (0 missing)
densidade < -0.7400479 to the right, improve=1.975493, (0 missing)
acucar_residual < -0.0888936 to the left, improve=1.550200, (0 missing)
Surrogate splits:
tsd < 0.1687793 to the right, agree=0.854, adj=0.52, (0 split)
grau_alcolico < 1.079215 to the left, agree=0.744, adj=0.16, (0 split)
acidez_volatil < -1.914234 to the left, agree=0.707, adj=0.04, (0 split)
densidade < 1.604725 to the right, agree=0.707, adj=0.04, (0 split)
Node number 10: 110 observations
predicted class=0 expected loss=0.1363636 P(node) =0.1065891
class counts: 95 15
probabilities: 0.864 0.136
Node number 11: 64 observations, complexity param=0.01918465
predicted class=0 expected loss=0.40625 P(node) =0.0620155
class counts: 38 26
probabilities: 0.594 0.406
left son=22 (36 obs) right son=23 (28 obs)
Primary splits:
PH < -0.2681564 to the right, improve=5.573413, (0 missing)
densidade < -1.004914 to the right, improve=4.017857, (0 missing)
cloretos < -0.01721581 to the right, improve=3.490385, (0 missing)
tsd < 0.4304702 to the right, improve=3.375000, (0 missing)
fsd < 0.6161762 to the right, improve=2.910437, (0 missing)
Surrogate splits:
acidez_fixa < 0.3885853 to the left, agree=0.797, adj=0.536, (0 split)
tsd < -0.3109926 to the right, agree=0.797, adj=0.536, (0 split)
densidade < 0.3584663 to the left, agree=0.719, adj=0.357, (0 split)
fsd < 0.280402 to the right, agree=0.719, adj=0.357, (0 split)
grau_alcolico < 0.4508009 to the right, agree=0.656, adj=0.214, (0 split)
Node number 12: 55 observations
predicted class=0 expected loss=0.1272727 P(node) =0.05329457
class counts: 48 7
probabilities: 0.873 0.127
Node number 13: 27 observations, complexity param=0.02158273
predicted class=1 expected loss=0.4814815 P(node) =0.02616279
class counts: 13 14
probabilities: 0.481 0.519
left son=26 (17 obs) right son=27 (10 obs)
Primary splits:
tsd < -1.173375 to the right, improve=2.516776, (0 missing)
densidade < -0.8400237 to the right, improve=2.167196, (0 missing)
grau_alcolico < 1.816099 to the right, improve=1.639376, (0 missing)
acidez_fixa < 1.107517 to the right, improve=1.516776, (0 missing)
acido_citrico < 1.445497 to the right, improve=1.516776, (0 missing)
Surrogate splits:
acido_citrico < 1.087227 to the right, agree=0.889, adj=0.7, (0 split)
cloretos < 0.4526027 to the left, agree=0.815, adj=0.5, (0 split)
fsd < -0.9931628 to the right, agree=0.815, adj=0.5, (0 split)
acidez_volatil < -0.8241137 to the left, agree=0.741, adj=0.3, (0 split)
acucar_residual < -0.0888936 to the right, agree=0.704, adj=0.2, (0 split)
Node number 14: 25 observations
predicted class=0 expected loss=0.36 P(node) =0.02422481
class counts: 16 9
probabilities: 0.640 0.360
Node number 15: 57 observations
predicted class=1 expected loss=0.1929825 P(node) =0.05523256
class counts: 11 46
probabilities: 0.193 0.807
Node number 22: 36 observations, complexity param=0.01438849
predicted class=0 expected loss=0.2222222 P(node) =0.03488372
class counts: 28 8
probabilities: 0.778 0.222
left son=44 (28 obs) right son=45 (8 obs)
Primary splits:
PH < 0.5743585 to the left, improve=3.337302, (0 missing)
acido_citrico < 0.9848646 to the right, improve=2.009662, (0 missing)
cloretos < -0.1937185 to the right, improve=2.000000, (0 missing)
acidez_volatil < -1.038808 to the right, improve=1.469444, (0 missing)
densidade < -0.702244 to the right, improve=1.185185, (0 missing)
Surrogate splits:
acido_citrico < 0.1147807 to the right, agree=0.806, adj=0.125, (0 split)
cloretos < -1.333856 to the right, agree=0.806, adj=0.125, (0 split)
fsd < 1.666146 to the left, agree=0.806, adj=0.125, (0 split)
Node number 23: 28 observations
predicted class=1 expected loss=0.3571429 P(node) =0.02713178
class counts: 10 18
probabilities: 0.357 0.643
Node number 26: 17 observations
predicted class=0 expected loss=0.3529412 P(node) =0.01647287
class counts: 11 6
probabilities: 0.647 0.353
Node number 27: 10 observations
predicted class=1 expected loss=0.2 P(node) =0.009689922
class counts: 2 8
probabilities: 0.200 0.800
Node number 44: 28 observations
predicted class=0 expected loss=0.1071429 P(node) =0.02713178
class counts: 25 3
probabilities: 0.893 0.107
Node number 45: 8 observations
predicted class=1 expected loss=0.375 P(node) =0.007751938
class counts: 3 5
probabilities: 0.375 0.625 
Análise da Qualidade do Modelo
DT_Preditor <- as.data.frame(predict(DT_Modelo01, newdata = df_vinho_tinto_teste))
DT_Preditor$factor <- as.factor(ifelse(DT_Preditor[["1"]] > DT_Preditor[["0"]],1,0))
confusionMatrix(DT_Preditor$factor, df_vinho_tinto_teste$GrupoQualidade)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 216 28
1 8 7
Accuracy : 0.861
95% CI : (0.8128, 0.9007)
No Information Rate : 0.8649
P-Value [Acc > NIR] : 0.615236
Kappa : 0.2165
Mcnemar's Test P-Value : 0.001542
Sensitivity : 0.9643
Specificity : 0.2000
Pos Pred Value : 0.8852
Neg Pred Value : 0.4667
Prevalence : 0.8649
Detection Rate : 0.8340
Detection Prevalence : 0.9421
Balanced Accuracy : 0.5821
'Positive' Class : 0
Vinho Branco
DT_Modelo01 <-rpart(GrupoQualidade ~ acidez_fixa+acidez_volatil+acido_citrico+acucar_residual+cloretos+densidade+fsd+grau_alcolico+PH+sulfatos+tsd, data = df_base_branco)
summary(DT_Modelo01)Call:
rpart(formula = GrupoQualidade ~ acidez_fixa + acidez_volatil +
acido_citrico + acucar_residual + cloretos + densidade +
fsd + grau_alcolico + PH + sulfatos + tsd, data = df_base_branco)
n= 3943
CP nsplit rel error xerror xstd
1 0.04323995 0 1.0000000 1.0000000 0.03105500
2 0.01461632 2 0.9135201 0.9403167 0.03034941
3 0.01096224 3 0.8989038 0.9317905 0.03024483
4 0.01000000 5 0.8769793 0.9427527 0.03037911
Variable importance
grau_alcolico densidade cloretos tsd acucar_residual sulfatos fsd acidez_fixa
44 26 14 7 4 2 2 1
Node number 1: 3943 observations, complexity param=0.04323995
predicted class=0 expected loss=0.2082171 P(node) =1
class counts: 3122 821
probabilities: 0.792 0.208
left son=2 (2421 obs) right son=3 (1522 obs)
Primary splits:
grau_alcolico < 10.85 to the left, improve=180.10410, (0 missing)
densidade < 0.99181 to the right, improve=138.13450, (0 missing)
cloretos < 0.0395 to the right, improve= 98.30691, (0 missing)
tsd < 153.5 to the right, improve= 55.31960, (0 missing)
acucar_residual < 6.15 to the right, improve= 32.35121, (0 missing)
Surrogate splits:
densidade < 0.992005 to the right, agree=0.863, adj=0.645, (0 split)
cloretos < 0.0375 to the right, agree=0.743, adj=0.334, (0 split)
tsd < 114.5 to the right, agree=0.683, adj=0.180, (0 split)
acucar_residual < 5.05 to the right, agree=0.648, adj=0.088, (0 split)
sulfatos < 0.375 to the right, agree=0.631, adj=0.045, (0 split)
Node number 2: 2421 observations
predicted class=0 expected loss=0.08839323 P(node) =0.6139995
class counts: 2207 214
probabilities: 0.912 0.088
Node number 3: 1522 observations, complexity param=0.04323995
predicted class=0 expected loss=0.3988173 P(node) =0.3860005
class counts: 915 607
probabilities: 0.601 0.399
left son=6 (1219 obs) right son=7 (303 obs)
Primary splits:
grau_alcolico < 12.55 to the left, improve=36.07178, (0 missing)
fsd < 11.5 to the left, improve=16.41962, (0 missing)
cloretos < 0.0395 to the right, improve=15.20868, (0 missing)
PH < 3.065 to the left, improve=13.54398, (0 missing)
acucar_residual < 2.05 to the left, improve=13.10818, (0 missing)
Surrogate splits:
densidade < 0.989595 to the right, agree=0.840, adj=0.195, (0 split)
acidez_volatil < 0.595 to the left, agree=0.804, adj=0.013, (0 split)
sulfatos < 0.275 to the right, agree=0.803, adj=0.010, (0 split)
tsd < 21.5 to the right, agree=0.803, adj=0.010, (0 split)
acidez_fixa < 4.75 to the right, agree=0.802, adj=0.003, (0 split)
Node number 6: 1219 observations
predicted class=0 expected loss=0.3445447 P(node) =0.3091555
class counts: 799 420
probabilities: 0.655 0.345
Node number 7: 303 observations, complexity param=0.01461632
predicted class=1 expected loss=0.3828383 P(node) =0.07684504
class counts: 116 187
probabilities: 0.383 0.617
left son=14 (14 obs) right son=15 (289 obs)
Primary splits:
cloretos < 0.0495 to the right, improve=8.743060, (0 missing)
fsd < 21.5 to the left, improve=8.341580, (0 missing)
tsd < 80.5 to the left, improve=4.984619, (0 missing)
acidez_volatil < 0.59 to the right, improve=4.055789, (0 missing)
PH < 3.385 to the left, improve=3.265254, (0 missing)
Node number 14: 14 observations
predicted class=0 expected loss=0.07142857 P(node) =0.003550596
class counts: 13 1
probabilities: 0.929 0.071
Node number 15: 289 observations, complexity param=0.01096224
predicted class=1 expected loss=0.3564014 P(node) =0.07329445
class counts: 103 186
probabilities: 0.356 0.644
left son=30 (83 obs) right son=31 (206 obs)
Primary splits:
fsd < 20.5 to the left, improve=8.036690, (0 missing)
tsd < 72.5 to the left, improve=5.800931, (0 missing)
acidez_volatil < 0.59 to the right, improve=4.639843, (0 missing)
PH < 3.385 to the left, improve=2.583294, (0 missing)
sulfatos < 0.305 to the right, improve=2.126465, (0 missing)
Surrogate splits:
tsd < 89 to the left, agree=0.796, adj=0.289, (0 split)
sulfatos < 0.68 to the right, agree=0.737, adj=0.084, (0 split)
acidez_volatil < 0.63 to the right, agree=0.723, adj=0.036, (0 split)
acucar_residual < 1.05 to the left, agree=0.720, adj=0.024, (0 split)
densidade < 0.993165 to the right, agree=0.720, adj=0.024, (0 split)
Node number 30: 83 observations, complexity param=0.01096224
predicted class=0 expected loss=0.4578313 P(node) =0.02104996
class counts: 45 38
probabilities: 0.542 0.458
left son=60 (42 obs) right son=61 (41 obs)
Primary splits:
acidez_fixa < 6.35 to the right, improve=5.037572, (0 missing)
fsd < 8.5 to the left, improve=3.934866, (0 missing)
grau_alcolico < 13.25 to the left, improve=3.213366, (0 missing)
densidade < 0.98989 to the right, improve=3.121098, (0 missing)
sulfatos < 0.325 to the right, improve=2.437902, (0 missing)
Surrogate splits:
densidade < 0.98961 to the right, agree=0.747, adj=0.488, (0 split)
acucar_residual < 3.25 to the right, agree=0.687, adj=0.366, (0 split)
PH < 3.265 to the left, agree=0.687, adj=0.366, (0 split)
grau_alcolico < 13.25 to the left, agree=0.627, adj=0.244, (0 split)
acido_citrico < 0.235 to the right, agree=0.602, adj=0.195, (0 split)
Node number 31: 206 observations
predicted class=1 expected loss=0.2815534 P(node) =0.05224448
class counts: 58 148
probabilities: 0.282 0.718
Node number 60: 42 observations
predicted class=0 expected loss=0.2857143 P(node) =0.01065179
class counts: 30 12
probabilities: 0.714 0.286
Node number 61: 41 observations
predicted class=1 expected loss=0.3658537 P(node) =0.01039817
class counts: 15 26
probabilities: 0.366 0.634 
DT_Preditor <- as.data.frame(predict(DT_Modelo01, newdata = df_vinho_branco_teste))
DT_Preditor$factor <- as.factor(ifelse(DT_Preditor[["1"]] > DT_Preditor[["0"]],1,0))
confusionMatrix(DT_Preditor$factor, df_vinho_branco_teste$GrupoQualidade)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 583 159
1 0 0
Accuracy : 0.7857
95% CI : (0.7544, 0.8147)
No Information Rate : 0.7857
P-Value [Acc > NIR] : 0.5212
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 1.0000
Specificity : 0.0000
Pos Pred Value : 0.7857
Neg Pred Value : NaN
Prevalence : 0.7857
Detection Rate : 0.7857
Detection Prevalence : 1.0000
Balanced Accuracy : 0.5000
'Positive' Class : 0
Regressão Logística
Técnica
A regressão logística é um modelo no qual classificamos na qual a variável dependente possuem valores binários (intervalos entre 0 e 1), ou seja, um ou o outro e as independentes podem ser categóricas ou não.
Este tipo de modelo lida muito bem com variáveis de entrada (independentes) de tipo categórica e possui um grau relativamente alto de confiabilidade.
Podemos dizer de modo geral que funciona como uma regressão linear, com exceção de que as variáveis dependentes devem ser categóricas e utiliza o método de máxima verossimilhança, ao invés dos mínimos quadrados como na regressão linear.
Como vimos, nosso dataset possui apenas dados numéricos, com exceção do tipo de vinho.
Criando modelo Árvore de Regressão Logística da variável de saída “qualidade” com todas as variáveis de entrada
Vinho Tinto
Modelo Vinho Tinto
RL_Modelo01 <- glm(qualidade ~ acidez_fixa+acidez_volatil+acido_citrico+acucar_residual+cloretos+densidade+fsd+grau_alcolico+PH+sulfatos+tsd, data = df_vinho_tinto_treino)
summary(RL_Modelo01)
Call:
glm(formula = qualidade ~ acidez_fixa + acidez_volatil + acido_citrico +
acucar_residual + cloretos + densidade + fsd + grau_alcolico +
PH + sulfatos + tsd, data = df_vinho_tinto_treino)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.91779 -0.42534 -0.02276 0.54255 2.23170
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.0005926 0.0240603 -0.025 0.9804
acidez_fixa 0.0989973 0.0644249 1.537 0.1247
acidez_volatil -0.2529691 0.0340139 -7.437 2.18e-13 ***
acido_citrico -0.0813844 0.0420323 -1.936 0.0531 .
acucar_residual 0.0337355 0.0340020 0.992 0.3214
cloretos -0.0292052 0.0330493 -0.884 0.3771
densidade -0.0807869 0.0650825 -1.241 0.2148
fsd 0.0604981 0.0432092 1.400 0.1618
grau_alcolico 0.3809766 0.0474714 8.025 2.77e-15 ***
PH -0.0952265 0.0457608 -2.081 0.0377 *
sulfatos 0.2302949 0.0296359 7.771 1.90e-14 ***
tsd -0.0877090 0.0452497 -1.938 0.0529 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for gaussian family taken to be 0.5907833)
Null deviance: 1001.6 on 1031 degrees of freedom
Residual deviance: 602.6 on 1020 degrees of freedom
AIC: 2399.5
Number of Fisher Scoring iterations: 2RL_Preditor <- predict.glm(RL_Modelo01, newdata = df_vinho_tinto_teste, type = 'response')
RL_Preditor_Corte <- as.factor(ifelse(RL_Preditor > 6,1,0))
confusionMatrix(RL_Preditor_Corte, df_vinho_tinto_teste$GrupoQualidade)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 224 35
1 0 0
Accuracy : 0.8649
95% CI : (0.8171, 0.904)
No Information Rate : 0.8649
P-Value [Acc > NIR] : 0.5449
Kappa : 0
Mcnemar's Test P-Value : 9.081e-09
Sensitivity : 1.0000
Specificity : 0.0000
Pos Pred Value : 0.8649
Neg Pred Value : NaN
Prevalence : 0.8649
Detection Rate : 0.8649
Detection Prevalence : 1.0000
Balanced Accuracy : 0.5000
'Positive' Class : 0
Vinho Branco
Modelo Vinho Branco
RL_Modelo01 <- glm(qualidade ~ acidez_fixa+acidez_volatil+acido_citrico+acucar_residual+cloretos+densidade+fsd+grau_alcolico+PH+sulfatos+tsd, data = df_vinho_branco_treino)
summary(RL_Modelo01)
Call:
glm(formula = qualidade ~ acidez_fixa + acidez_volatil + acido_citrico +
acucar_residual + cloretos + densidade + fsd + grau_alcolico +
PH + sulfatos + tsd, data = df_vinho_branco_treino)
Deviance Residuals:
Min 1Q Median 3Q Max
-3.7158 -0.5311 -0.0277 0.5226 3.4384
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.008325 0.015059 0.553 0.58045
acidez_fixa 0.068133 0.023397 2.912 0.00362 **
acidez_volatil -0.150709 0.016759 -8.993 < 2e-16 ***
acido_citrico 0.053721 0.018986 2.829 0.00469 **
acucar_residual 0.344473 0.036732 9.378 < 2e-16 ***
cloretos -0.109751 0.020807 -5.275 1.43e-07 ***
densidade -0.440484 0.061300 -7.186 8.43e-13 ***
fsd 0.186139 0.021158 8.797 < 2e-16 ***
grau_alcolico 0.212618 0.039284 5.412 6.72e-08 ***
PH 0.138252 0.020761 6.659 3.27e-11 ***
sulfatos 0.080651 0.016046 5.026 5.30e-07 ***
tsd -0.062914 0.024020 -2.619 0.00886 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for gaussian family taken to be 0.6668441)
Null deviance: 2869.4 on 2965 degrees of freedom
Residual deviance: 1969.9 on 2954 degrees of freedom
AIC: 7229.3
Number of Fisher Scoring iterations: 2RL_Preditor <- predict.glm(RL_Modelo01, newdata = df_vinho_branco_teste, type = 'response')
RL_Preditor_Corte <- as.factor(ifelse(RL_Preditor > 6,1,0))
confusionMatrix(RL_Preditor_Corte, df_vinho_branco_teste$GrupoQualidade)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 583 159
1 0 0
Accuracy : 0.7857
95% CI : (0.7544, 0.8147)
No Information Rate : 0.7857
P-Value [Acc > NIR] : 0.5212
Kappa : 0
Mcnemar's Test P-Value : <2e-16
Sensitivity : 1.0000
Specificity : 0.0000
Pos Pred Value : 0.7857
Neg Pred Value : NaN
Prevalence : 0.7857
Detection Rate : 0.7857
Detection Prevalence : 1.0000
Balanced Accuracy : 0.5000
'Positive' Class : 0
PCA
Técnica
Este algoritmo provê redução de dimensionalidade. Algumas vezes você tem uma grande quantidade de características, provavelmente muito correlacionadas entre si, e os modelos podem facilmente serem sobreajustados em um grande conjunto de dados. Neste cenário, aplica-se PCA. PCA calcula a projeção dos dados em algum vetor que maximize a variança dos dados e perca a menor quantidade de informação possível. Surpreendentemente, estes vetores são os autovetores da matriz de correlação das características de um conjunto de dados.
Vinho Tinto
Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10 PC11 PC12
Standard deviation 1.7669 1.4852 1.2898 1.1185 0.98442 0.80767 0.78325 0.72387 0.63491 0.57640 0.43721 0.2683
Proportion of Variance 0.2602 0.1838 0.1386 0.1043 0.08076 0.05436 0.05112 0.04367 0.03359 0.02769 0.01593 0.0060
Cumulative Proportion 0.2602 0.4440 0.5826 0.6869 0.76764 0.82200 0.87313 0.91679 0.95038 0.97807 0.99400 1.0000plot(1:12, TintoPCA$sdev^2, type = "b", xlab = "Componente",
ylab = "Variância", main = "Vinhos tintos", sub = "Dados não normalizados previamente", pch = 20, cex.axis = 0.8, cex.lab = 0.8)
Vinho Tinto base normalizada
Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10 PC11 PC12
Standard deviation 1.7717 1.5858 1.3130 1.07159 0.94306 0.83041 0.76852 0.69788 0.59553 0.50143 0.38072 0.25759
Proportion of Variance 0.2616 0.2096 0.1437 0.09569 0.07411 0.05746 0.04922 0.04059 0.02955 0.02095 0.01208 0.00553
Cumulative Proportion 0.2616 0.4711 0.6148 0.71050 0.78461 0.84208 0.89130 0.93188 0.96144 0.98239 0.99447 1.00000plot(1:12, TintoPCA$sdev^2, type = "b", xlab = "Componente",
ylab = "Variância", main = "Vinhos tintos", sub = "Dados normalizados previamente(Box Cox)", pch = 20, cex.axis = 0.8, cex.lab = 0.8)
Vinho Branco
Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10 PC11 PC12
Standard deviation 1.8309 1.2696 1.1724 1.04334 0.99212 0.96539 0.8743 0.83039 0.74504 0.59230 0.52930 0.12790
Proportion of Variance 0.2794 0.1343 0.1145 0.09071 0.08202 0.07766 0.0637 0.05746 0.04626 0.02923 0.02335 0.00136
Cumulative Proportion 0.2794 0.4137 0.5282 0.61895 0.70097 0.77864 0.8423 0.89980 0.94606 0.97529 0.99864 1.00000plot(1:12, BrancoPCA$sdev^2, type = "b", xlab = "Componente",
ylab = "Variância", main = "Vinhos brancos", sub = "Dados não normalizados previamente", pch = 20, cex.axis = 0.8, cex.lab = 0.8)
Vinho Branco base normalizada
Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10 PC11 PC12
Standard deviation 1.8674 1.2661 1.1941 1.09115 0.97684 0.88877 0.83892 0.7792 0.75807 0.59467 0.52386 0.18850
Proportion of Variance 0.2906 0.1336 0.1188 0.09922 0.07952 0.06583 0.05865 0.0506 0.04789 0.02947 0.02287 0.00296
Cumulative Proportion 0.2906 0.4242 0.5430 0.64222 0.72174 0.78756 0.84621 0.8968 0.94470 0.97417 0.99704 1.00000plot(1:12, BrancoPCA$sdev^2, type = "b", xlab = "Componente",
ylab = "Variância", main = "Vinhos brancos", sub = "Dados normalizados previamente(Box Cox)", pch = 20, cex.axis = 0.8, cex.lab = 0.8)
Conclusão sobre PCA base normaliza vs base bruta
Esses 4 gráficos anteriores foram plotados para gerar a discussão sobre utilizar PCA com dados normalizados previamente ou não, para uma comparação de qual estratégia maximiza mais a variança dos dados.
O próprio algoritmo PCA trabalha na a variancia dos dados, mas usando os dados previamente tratados em relação a variancia com a função Box Cox, vemos que os gráficos dos dados previamente tratado são mais uniformes e é menor a discrepância de valors em certas componentes.
K-Means
Técnica
K-means é um algoritmo de aprendizagem não supervisionada que agrupa dados com base em sua similaridade. Aprendizagem não supervisionada significa que não há resultado a ser previsto, e o algoritmo apenas tenta encontrar padrões nos dados. No k-means, temos que especificar o número de grupos em que desejamos que os dados sejam agrupados. O algoritmo atribui aleatoriamente cada observação para um cluster, e encontra o centróide de cada cluster. Em seguida, o algoritmo segue em dois passos:
• Redistribui pontos de dados para o cluster cujo centróide é mais próximo.
• Calcula novo centróide para cada cluster.
Estes dois passos são repetidos até que a variação dentro do conjunto não possa mais ser reduzida. A variação dentro do cluster é calculada como a soma da distância euclidiana entre os pontos de dados e os os respectivos centróides de clusters.
Vinho Tinto
Resultado <- kmeans(df_tinto[9:10], 5);
precisao.tinto.kmeans = Resultado$betweenss / Resultado$totss * 100
Resultado$size [1] 361 262 171 180 317plot(df_tinto[9:10], col = Resultado$cluster, pch= 19)
points(Resultado$centers[9:10], col="RED", pch=7, cex=4)
[1] 276 154 393 225 243plot(df_tinto[11:10], col = Resultado$cluster, pch= 19)
points(Resultado$centers[11:10], col="RED", pch=7, cex=4)
[1] 219 227 214 243 388plot(df_tinto[11:9], col = Resultado$cluster, pch= 19)
points(Resultado$centers[11:9], col="RED", pch=7, cex=4)
### Algumas relações que conseguimos inferir com algortimo K-means para as variáveis alcoólico, sulfatos e pH na base vinho tinto
Baixo teor alcoólico, baixos sulfatos baixos sulfatos, álcool elevado baixo pH, baixo teor alcoólico pH elevado, álcool alto pH elevado, baixos sulfatos baixo pH, altos sulfatos
Vinho Branco
Resultado <- kmeans(df_branco[9:10], 5);
precisao.branco.kmeans = Resultado$betweenss / Resultado$totss * 100
Resultado$size[1] 730 1023 546 932 477plot(df_branco[9:10], col = Resultado$cluster, pch= 19)
points(Resultado$centers[9:10], col="RED", pch=7, cex=4)
[1] 762 761 630 718 837plot(df_branco[11:10], col = Resultado$cluster, pch= 19)
points(Resultado$centers[11:10], col="RED", pch=7, cex=4)
[1] 681 1143 512 715 657plot(df_branco[11:9], col = Resultado$cluster, pch= 19)
points(Resultado$centers[11:9], col="RED", pch=7, cex=4)
Algumas relações que conseguimos inferir com algortimo K-means para as variáveis alcoólico, sulfatos e pH na base vinho branco
Para vinh branco é possível visualizar que para pH muito não temos tanto sulfatos altos como na base vinho tintos e que há maior número de dados na faixa intermediária (-1 à 1, em ambos eixos), em relação a base vinho tintos
Na relação grau alcoólico e sulfatos, vemos que na base de vinhos brancos os dados são mais bem distribuídos, onde é notório que para grau alcoólico mais elevado temos tanto sultados baixo como altos.
Na comparação, das 3 variáveis juntas, é possível verificar que há maior quantidade de dados na faixa de pH baixo e grau alcoólico alto na base vinhos brancos do que vinhos tintos.
Cluster Hierárquico
Técnica
Separar um conjunto de objetos em grupos (clusters) de forma que os membros de qualquer grupo formado sejam os mais homogêneos possíveis com relação a algum critério (uso de medidas de distância)
Hierárquicos: identificam agrupamentos e o provável o n° g de grupos/clusters
Separando Base Vinho
Vinho Tinto
Distância Euclidiana
Métodos hierárquicos usam uma matriz de distância como uma entrada para o algoritmo de clustering. A escolha de uma métrica apropriada influenciará a forma dos aglomerados, pois alguns elementos podem estar próximos uns dos outros de acordo com uma distância e distantes de acordo com a outra.
8 15 30 34 36 40 42 50 54 59 61 63 64 65 68 75 79 82 85 86 94 107 109 110 113 115 131 134 135 156 158 159 162 167 170 172 173 175 190 199 207 209 214 220 230 242 247 251 258 266 271 274 288 301 315 318 320 328 329 343 358 362 364 368 371 381 383 388 389 395 399 400 403 408 410 417 433 436 453 457 464
15 1.38954653
465 466 467 469 474 492 497 499 508 512 514 531 533 537 540 544 546 547 548 549 574 579 584 590 600 608 614 618 622 638 639 644 661 665 675 676 686 688 689 697 698 699 709 716 719 720 722 731 738 739 748 751 765 766 769 772 773 778 786 792 812 816 824 825 833 834 838 839 845 850 857 869 872 880 883 885 896 898 902 911 913
15
921 926 930 934 939 965 966 977 978 982 986 992 993 999 1003 1008 1012 1016 1019 1022 1025 1031 1036 1042 1048 1060 1066 1071 1076 1084 1092 1099 1105 1112 1125 1126 1128 1131 1133 1134 1135 1136 1140 1144 1145 1152 1153 1157 1160 1163 1164 1168 1171 1173 1174 1176 1178 1179 1180 1191 1192 1194 1197 1199 1206 1217 1221 1222 1224 1225 1242 1247 1248 1252 1254 1258 1263 1267 1275 1276 1281
15
1286 1289 1296 1303 1305 1310 1314 1318 1325 1327 1334 1340 1347 1350 1352
15
[ reached getOption("max.print") -- omitted 257 rows ]Dendrograma
O dendrograma é um diagrama de árvore que exibe os grupos formados por agrupamento de observações em cada passo e em seus níveis de similaridade. O nível de similaridade é medido ao longo do eixo vertical (alternativamente, você pode exibir o nível de distância) e as diferentes observações são listadas ao longo do eixo horizontal.
Usamos a distância euclidiana como uma entrada para o algoritmo de agrupamento (o critério de variação mínima de Ward minimiza a variação total dentro do cluster)
fit1 <-hclust(d1, method = "ward.D")
plot(fit1, hang = -1)
groups1 <- cutree(fit1, k=3)
rect.hclust(fit1, k=3, border="red")
Resultado com Matriz de Confusão
O desempenho do cluster pode ser avaliado com o auxilio da matrix de confusão.
groups1
1 2 3
-3.44310027880038 2 0 0
-2.04402772564941 10 0 0
-0.747246609931666 101 9 0
0.473443946465285 0 64 38
1.6342877682675 0 0 32
2.74624401441151 0 0 3Esse Dendrograma foi criado usando uma partição de 3 agrupamentos para cada tipo de vinho, baseado em nivel de similaridade.
Vinho Branco
Distância Euclidiana
Métodos hierárquicos usam uma matriz de distância como uma entrada para o algoritmo de clustering. A escolha de uma métrica apropriada influenciará a forma dos aglomerados, pois alguns elementos podem estar próximos uns dos outros de acordo com uma distância e distantes de acordo com a outra.
4 14 16 17 19 24 25 32 35 38 41 53 54 61 68 74 75 80 101 102 109 110 115 116 128 142 148 154 163 164 170 182 184 193 201 205 206 210 216 218 221 237 241 242 250 252 267 270 274 283 285 289 291 295 308 315 325 333 339 340 343 344 357 358 360 366 387 388 398 400 406 415 422 424 425 431 450 462 466 473 479
489 494 505 513 523 544 549 551 557 572 597 599 619 628 631 634 639 644 645 647 651 662 663 668 669 687 688 701 706 707 710 736 739 742 746 752 753 754 759 766 768 775 779 802 803 808 810 811 814 816 819 825 826 835 836 844 845 846 859 861 868 883 889 890 899 901 914 920 926 938 940 943 953 959 962 970 978 982 987 989 1000
1001 1012 1013 1016 1024 1033 1036 1047 1048 1054 1056 1058 1063 1069 1077 1083 1091 1094 1100 1104 1106 1117 1121 1126 1129 1132 1138 1141 1142 1143 1154 1167 1175 1185 1188 1194 1196 1198 1199 1201 1203 1204 1211 1217 1218 1220 1228 1230 1231 1235 1236 1254 1255 1256 1258 1267 1280 1282 1285 1310 1318 1320 1323 1327 1328 1329 1330 1342 1352 1356 1360 1365 1371 1375 1380 1382 1389 1394 1398 1415 1425
1432 1439 1446 1450 1452 1456 1461 1462 1466 1472 1490 1499 1503 1512 1515 1536 1545 1550 1551 1554 1568 1570 1571 1577 1580 1587 1590 1596 1603 1608 1618 1626 1633 1641 1643 1648 1662 1676 1680 1689 1699 1700 1703 1708 1710 1715 1723 1726 1735 1736 1741 1746 1754 1761 1763 1765 1766 1775 1776 1778 1780 1781 1787 1788 1804 1810 1813 1821 1823 1824 1829 1832 1837 1840 1843 1846 1852 1854 1863 1873 1880
1881 1883 1884 1889 1903 1906 1907 1910 1914 1921 1925 1926 1928 1937 1941 1943 1954 1957 1966 1969 1970 1977 1983 2001 2007 2010 2017 2025 2027 2030 2037 2046 2048 2052 2053 2058 2059 2068 2070 2072 2077 2082 2084 2086 2091 2092 2097 2101 2108 2109 2111 2113 2114 2122 2124 2133 2143 2146 2148 2158 2159 2160 2165 2166 2167 2175 2176 2182 2184 2186 2189 2193 2202 2203 2205 2207 2216 2229 2232 2239 2256
2258 2259 2265 2272 2274 2282 2286 2290 2291 2293 2308 2309 2315 2319 2320 2325 2332 2333 2334 2342 2343 2347 2351 2358 2360 2363 2366 2367 2368 2376 2388 2389 2396 2403 2407 2412 2413 2427 2432 2439 2443 2445 2457 2459 2467 2470 2472 2475 2478 2481 2484 2492 2493 2496 2498 2506 2510 2513 2527 2530 2533 2536 2543 2545 2547 2548 2549 2552 2564 2576 2584 2591 2592 2593 2607 2611 2613 2617 2624 2630 2632
2637 2645 2647 2649 2651 2652 2654 2662 2663 2664 2669 2673 2674 2677 2681 2696 2699 2700 2711 2715 2724 2729 2730 2737 2744 2754 2761 2770 2771 2774 2775 2779 2782 2783 2788 2796 2804 2805 2808 2813 2814 2821 2822 2824 2834 2835 2839 2840 2845 2848 2850 2855 2856 2860 2862 2871 2878 2882 2884 2886 2889 2891 2910 2911 2930 2932 2936 2940 2942 2949 2958 2968 2970 2971 2973 2977 2979 3000 3002 3006 3015
3019 3020 3022 3023 3025 3032 3034 3037 3041 3051 3061 3064 3074 3075 3087 3093 3096 3097 3100 3102 3104 3114 3119 3123 3130 3143 3148 3156 3157 3158 3163 3174 3180 3186 3187 3188 3194 3209 3215 3219 3221 3222 3224 3225 3255 3256 3265 3271 3273 3281 3283 3292 3301 3302 3310 3317 3331 3332 3335 3336 3341 3356 3360 3366 3369 3371 3373 3377 3383 3390 3391 3397 3400 3407 3410 3416 3417 3426 3439 3444 3452
3453 3459 3470 3471 3474 3476 3483 3489 3502 3507 3510 3512 3521 3522 3523 3528 3529 3531 3550 3552 3558 3560 3574 3577 3583 3585 3587 3595 3604 3606 3618 3623 3626 3627 3652 3661 3675 3686 3687 3693 3698 3700 3703 3710 3713 3717 3720 3721 3722 3723 3725 3730 3736 3742 3743 3753 3758 3768 3772 3777 3778 3779 3789 3791 3799 3801 3802 3806 3807 3813 3827 3829 3834 3840 3842 3847 3849 3854 3860 3866 3876
3881 3886 3887 3888 3897 3901 3905 3917 3922 3925 3933 3938
[ reached getOption("max.print") -- omitted 741 rows ]Dendrograma
O dendrograma é um diagrama de árvore que exibe os grupos formados por agrupamento de observações em cada passo e em seus níveis de similaridade. O nível de similaridade é medido ao longo do eixo vertical (alternativamente, você pode exibir o nível de distância) e as diferentes observações são listadas ao longo do eixo horizontal.
Usamos a distância euclidiana como uma entrada para o algoritmo de agrupamento (o critério de variação mínima de Ward minimiza a variação total dentro do cluster)
fit2 <-hclust(d2, method = "ward.D")
plot(fit2, hang = -1)
groups2 <- cutree(fit2, k=3)
rect.hclust(fit2, k=3, border="red")
Resultado com Matriz de Confusão
O desempenho do cluster pode ser avaliado com o auxilio da matrix de confusão.
groups2
1 2 3
-3.20339999163715 0 0 2
-2.08134205728295 0 13 14
-0.959284122928742 14 21 182
0.162773811425464 171 166 0
1.28483174577967 100 33 0
2.40688968013388 20 5 0
3.52894761448808 1 0 0Esse Dendrograma foi criado usando uma partição de 3 agrupamentos para cada tipo de vinho, baseado em nivel de similaridade.
Conclusão
Precisão Prevista
Vinho Tinto
precisao.tinto = data.frame("Técnica" = c("Regressão Linear",
"Árvore Regressão",
"Árvore Decisao",
"Regressão Logística",
"K-Means"),
"Acurácia" = c(as.numeric(precisao.tinto.rlinear),
as.numeric(precisao.tinto.aregressao),
as.numeric(precisao.tinto.adecisao),
as.numeric(precisao.tinto.rlogistica),
as.numeric(precisao.tinto.kmeans)),
stringsAsFactors = FALSE)
ggplot(precisao.tinto, aes(x=Técnica, y=Acurácia, fill=Técnica)) +
geom_bar(stat="identity") +
scale_fill_hue(c = 40)
Vinho Branco
precisao.branco = data.frame("Técnica" = c("Regressão Linear",
"Árvore Regressão",
"Árvore Decisão",
"Regressão Logística",
"K-Means"),
"Acurácia" = c(as.numeric(precisao.branco.rlinear),
as.numeric(precisao.branco.aregressao),
as.numeric(precisao.branco.adecisao),
as.numeric(precisao.branco.rlogistica),
as.numeric(precisao.branco.kmeans)),
stringsAsFactors = FALSE)
ggplot(precisao.branco, aes(x=Técnica, y=Acurácia, fill=Técnica)) +
geom_bar(stat="identity") +
scale_fill_hue(c = 40)
Análise Final
Segue abaixo o resultado final do Grupo E2GR referente a Análise de Qualidade dos Vinhos:
Os vinhos devem ser analisados separadamente porque seus preditores divergem.
Efetuamos uma higienização do dataset por causa das duplicidades
Efetuamos a normalização dos dados utilizando a Técnica Box Cox para alcançar os objetivos.
Acreditamos que os algoritimos de Regressão Logística tendem a ser mais precisos.
Motivado por conta do grupo classificador de determinância de qualidade se é bom, médio ou ruim.
??? …Importação… ???